VBA Create a macro that creates new macros - 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.