VBA Создать макрос, который создает новые макросы

Question

У меня есть макрос, который вставляет в форму элементы управления Изображение .
При нажатии этих элементов управления пользователю предлагается выбрать файл изображения с помощью диалогового окна GetOpenFileName.Выбранное изображение загружается в элемент управления, а путь к файлу добавляется в столбец B в Sheet2.
Когда снова нажимается элемент управления Изображение , выбранное изображение загружается в Изображение управления на второй форме и отображается.

Как добавить или прикрепить требуемый код к каждому элементу управления изображением, чтобы сработали события 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

Каждый Изображение элемент управления на пользовательской форме будет нуждаться в событии щелчка.Это одиночное событие сохраняется в модуле class и прикрепляется к каждому элементу управления 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 вверху и элемент управления изображением внизу (я поставил Top на 218 для элемента управления изображением).
  Эти элементы управления, вероятно, не будутвключены в ваше окончательное решение, но дают различные варианты в зависимости от ваших требований.

• Добавьте приведенный ниже код к UserForm1.
  Этот код сработает при открытии формы.

  • Верхняя часть кода прикрепит событие Click к любым существующим элементам управления Image - таким, как тот, который расположен рядом с нижним.
  • В нижней части кода будет создан элемент управления Image для каждого пути к файлу, указанному в Sheet2 столбце B, и прикреплено к нему событие 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, который вы добавили.
  Это добавит Изображение элемент управления каждый раз, когда вы нажимаете кнопку.
  Примечание - 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 и добавьте один Image элемент управления с именем Image1, заполняющий форму.Я оставил форму с именем UserForm2.

Для использования:

• Открыть UserForm1.
  • Элемент управления Image будет создан для каждого полного пути к файлу и имени, указанного в столбце B из Sheet2.Это будет отображать изображение из пути к файлу.
  • Нажатие на кнопку создаст пустой элемент управления Изображение .
  • Нажатие на пустой элемент управления Изображение откроет диалоговое окно с просьбой выбрать файл,Выбранный файл будет загружен в элемент управления, а путь к файлу добавлен в столбец B в Sheet2.
  • Если щелкнуть элемент управления Изображение , содержащий изображение, откроется UserForm2 с изображением, загруженным в элемент управления Изображение этой формы.