VBA创建一个宏，该宏创建新的宏

Question

我有一个宏，可以在窗体上插入Image控件。
单击这些控件后，将要求用户使用GetOpenFileName对话框选择图像文件。 所选图像被加载到控件中，文件路径被添加到Sheet2 B列。
当再次单击Image控件时，所选图像将被加载到第二个窗体上的Image控件中并显示。

如何将所需的代码添加或附加到每个图像控件，以便Click事件起作用？

我到目前为止的代码如下：

Sub macroA1()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Set miesto = Sheets("Sheet2").Range("B2")
strfilename = Sheets("Sheet2").Range("B2").Value
If strfilename = "" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff     Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
ElseIf strfilename = "False" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
Else
Sheets("Sheet2").Range("B2").Value = strfilename
End If

On Error Resume Next
UserForm1.Image1.Picture = LoadPicture(strfilename)

If strfilename = "False" Then
MsgBox "File Not Selected!"
Exit Sub
Else
End If

UserForm1.Image1.PictureSizeMode = fmPictureSizeModeStretch
UserForm1.Show

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True


End Sub

Answer 1

用户窗体上的每个Image控件都需要一个click事件。 该单个事件存储在类模块中，并附加到窗体上的每个Image控件。

• 插入一个类模块，将其命名为clsLoadImage并在其下面添加代码。

---

Public WithEvents Img As MSForms.Image 'Place at very top of module (after Option Explicit though).

Private Sub Img_Click()

    Dim FullPath As String

    With Img
        'Only load the picture if the control is empty.
        If .Picture Is Nothing Then

            'Get the file path for the image.
            FullPath = Application.GetOpenFilename

            If Len(Dir(FullPath)) = 0 Then
                MsgBox "No file find.", vbOKOnly + vbCritical
            Else
                .Tag = FullPath 'The Tag property can store extra info such as a text string.

                'Store the path in last row of Sheet2 column B.
                ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1) = FullPath

                .Picture = LoadPicture(FullPath)
                .PictureSizeMode = fmPictureSizeModeStretch
                .Parent.Repaint
            End If
        Else

            'If the image control isn't empty load the image
            'into UserForm2 using the file path stored in
            'the Tag property.

            Load UserForm2
            With UserForm2
                With .Image1
                    .Picture = LoadPicture(Img.Tag)
                    .PictureSizeMode = fmPictureSizeModeStretch
                    .Parent.Repaint
                End With
                .Show
            End With

        End If
    End With

End Sub

• 接下来，将一个UserForm添加到项目中。 在示例代码中，我将其保留为UserForm1 。 使Height至少为340且相当宽。

• 在顶部附近添加一个CommandButton，在底部附近添加一个Image控件（我将Top放置在218作为图像控件）。
  这些控件可能不会包含在最终解决方案中，但是会根据您的要求提供不同的选项。

• 将以下代码添加到UserForm1 。
  打开表单时，此代码将触发。

  • 代码的顶部会将Click事件附加到任何现有的Image控件-例如位于底部附近的控件。
  • 代码的底部将为Sheet2列B列出的每个文件路径创建一个Image控件，并将Click事件附加到该控件。
    注意：“ Top设置为134，将它们放置在表单的中间区域。

---

Public ImageControls As New Collection 'Place at very top of module (after Option Explicit though).

'Could execute when the form opens.
'''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Initialize()

    'Relies on image controls added at design time.
    'Attaches the click event to each image control.

    Dim Ctrl As Control
    Set ImageControls = New Collection
    Dim ImgEvent As clsLoadImage

    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "Image" Then
            Set ImgEvent = New clsLoadImage
            Set ImgEvent.Img = Ctrl
            ImageControls.Add ImgEvent
        End If
    Next Ctrl

    ''''''''''''''''''''''''''''''''''''''''''''

    'Creates an image control for each file path
    'in Sheet2 column B, loads the picture,
    'stores the path in the tag property,
    'attaches the click event.

    Dim x As Long
    Dim tmpCtrl As Control

    For x = 2 To ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row

        'Add the control, name it and position it.
        Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "AddedInLoop_Image_" & x)
        With tmpCtrl
            .Left = .Width * (x - 2)
            .Top = 134
            .Picture = LoadPicture(ThisWorkbook.Worksheets("Sheet2").Cells(x, 2))
            .PictureSizeMode = fmPictureSizeModeStretch
            .Tag = ThisWorkbook.Worksheets("Sheet2").Cells(x, 2)
        End With

        'Attach the Click event to the control.
        Set ImgEvent = New clsLoadImage
        Set ImgEvent.Img = tmpCtrl
        ImageControls.Add ImgEvent

    Next x
    Me.Repaint

End Sub

• 将此代码也添加到UserForm1 ，以处理您添加的CommandButton。
  每次您按下按钮时，都会添加一个Image控件。
  注意- Top设置为40，因此它们将显示在表单顶部附近。

---

'Creates an image control and attaches
'a Click event to the control.
Private Sub CommandButton1_Click()

    Dim CtrlCount As Long
    Dim Ctrl As Control
    Dim tmpCtrl As Control
    Dim ImgEvent As clsLoadImage

    'Count the Image controls so each
    'new control has a unique name.
    CtrlCount = 1
    For Each Ctrl In Me.Controls
        'NB: The InStr command is only needed so the controls
        '    added in the Initalise event aren't counted.
        If TypeName(Ctrl) = "Image" And InStr(Ctrl.Name, "BtnClck_Image_") > 0 Then
            CtrlCount = CtrlCount + 1
        End If
    Next Ctrl

    'Add the control, name it and position it.
    Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "BtnClck_Image_" & CtrlCount)
    With tmpCtrl
        .Left = .Width * (CtrlCount - 1)
        .Top = 40
    End With

    'Attach the Click event to the control.
    Set ImgEvent = New clsLoadImage
    Set ImgEvent.Img = tmpCtrl
    ImageControls.Add ImgEvent

End Sub  

最后，添加第二个UserForm并添加一个名为Image1 图像控件来填充表单。 我离开了名为UserForm2的表单。

使用方法：

• 打开UserForm1 。
  • 将为Sheet2 B列中列出的每个完整文件路径和名称创建一个Image控件。 它将显示文件路径中的图片。
  • 按下按钮将创建一个空白的图像控件。
  • 单击空白的图像控件将打开一个对话框，要求您选择一个文件。 所选文件将被加载到控件中，文件路径将添加到Sheet2 B列。
  • 单击包含图片的Image控件将打开UserForm2 ，并将图像加载到该UserForm2的Image控件中。