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

Question

I have a macro that inserts Image controls on a form.
When these controls are clicked the user is asked to select an image file using the GetOpenFileName dialog box. The selected image is loaded into the control and the file path is added to column B on Sheet2 .
When the Image control is clicked again the selected image is loaded to an Image control on a second form and displayed.

How do I add or attach the required code to each image control so the Click events will work?

The code I have so far is below:

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

Each Image control on your userform will need a click event. This single event is stored within a class module and attached to each Image control on the form.

• Insert a class module, name it clsLoadImage and add the code below to it.

---

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

• Next add a UserForm to the project. In the sample code I have left it named as UserForm1 . Make the Height at at least 340 and fairly wide.

• Add a CommandButton near the top and an Image control near the bottom (I put the Top at 218 for the image control).
  These controls probably won't be included in your final solution but give different options depending on your requirements.

• Add the below code to UserForm1 .
  This code will fire when you open the form.

  • The top part of the code will attach the Click event to any existing Image controls - such as the one that's placed near the bottom.
  • The bottom part of the code will create an Image control for each file path listed in Sheet2 column B and attach the Click event to it.
    Note: Top is set as 134 placing them in the middle area of the form.

---

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

• Add this code to UserForm1 as well to deal with the CommandButton that you added.
  This will add an Image control each time you press the button.
  Note - Top is set at 40 so they'll appear near the top of the form.

---

'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  

Finally, add a second UserForm and add a single Image control named Image1 filling the form. I have left the form named as UserForm2 .

To use:

• Open UserForm1 .
  • An Image control will be created for each full file path & name listed in column B of Sheet2 . It will display the picture from the file path.
  • Pressing the button will create a blank Image control.
  • Clicking a blank Image control will open a dialog box asking you to select a file. The selected file will be loaded into the control and the file path added to column B on Sheet2 .
  • Clicking an Image control that contains a picture will open UserForm2 with the image loaded into the Image control on that form.