I have a code which adds a Combo Box in a user form at run time. The combo box has list of image names in a folder. When a user select image names it sets the image as the background image of the user form.
But the dynamic combo box only changes the background image only once i.e. UserForm_Initialize
event in the below code while the combo box I added in design works perfectly i.e. changes the background of the user form whenever the Combo Box value changes.
UserForm1
Private Sub UserForm_Initialize()
'AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage Me
With CreateObject("Scripting.FileSystemObject")
For Each fl In .GetFolder(ThisWorkbook.Path & "\Images\BackgroundImages\").Files
cmbBackgroundImg.AddItem fl.Name
Next fl
End With
cmbBackgroundImgName = RegKeyRead("HKCU\Software\ExcelAssistant\BackGroundImageName")
If cmbBackgroundImgName <> "" Then
If CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path & "\Images\BackgroundImages\" & cmbBackgroundImgName) = True Then
cmbBackgroundImg.Text = cmbBackgroundImgName
RegKeySave "HKCU\Software\BPOUtility\BackGroundImageName", cmbBackgroundImg.Text
End If
End If
End Sub
Private Sub cmbBackgroundImg_Change()
On Error Resume Next
If cmbBackgroundImg.Text = "" Then
Me.Picture = Nothing
Else
Me.Picture = LoadPicture(ThisWorkbook.Path & "\Images\BackgroundImages\" & cmbBackgroundImg.Text)
Me.PictureSizeMode = fmPictureSizeModeStretch
RegKeySave "HKCU\Software\ExcelAssistant\BackGroundImageName", cmbBackgroundImg.Text
End If
End Sub
Module1
Public Function AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage(frm As MSForms.UserForm)
Dim CmbBox As MSForms.Control, EventHandlerCollection As New Collection, _
cmbeventhandler As CtrlEvents
Set CmbBox = frm.Controls.Add("Forms.ComboBox.1", "cmbBackgroundImage")
Set cmbeventhandler = New CtrlEvents
cmbeventhandler.AssignComboBox CmbBox
EventHandlerCollection.Add cmbeventhandler
With CreateObject("Scripting.FileSystemObject")
For Each fl In .GetFolder(ThisWorkbook.Path & "\Images\BackgroundImages\").Files
CmbBox.AddItem fl.Name
Next fl
cmbBackgroundImgName = "asoggetti-cfKC0UOZHJo-unsplash.bmp"
If cmbBackgroundImgName <> "" Then
If .FileExists(ThisWorkbook.Path & "\Images\BackgroundImages\" & cmbBackgroundImgName) = True Then
CmbBox.Text = cmbBackgroundImgName
End If
End If
End With
End Function
Public Function GetUserFormOfControl(Obj As Object) As UserForm
Dim ParentType As String, TempObj As Object
Set TempObj = Obj
Do Until ParentType = "UserForm"
If Not TypeOf TempObj Is MSForms.Control Then
ParentType = "UserForm"
Set GetUserFormOfControl = TempObj
Else
Set TempObj = TempObj.Parent
CtrlName = TempObj.Name
End If
Loop
End Function
Public Function RegKeyRead(i_RegKey As String) As String
On Error Resume Next
RegKeyRead = CreateObject("WScript.Shell").regread(i_RegKey)
End Function
Public Function RegKeySave(i_RegKey As String, i_Value As String, Optional i_Type As String = "REG_SZ")
CreateObject("WScript.Shell").RegWrite i_RegKey, i_Value, i_Type
End Function
CtrlEvents Class
Public WithEvents m_combobox As MSForms.ComboBox
Private Sub m_combobox_Change()
If m_combobox.Name = "cmbBackgroundImage" Then
If m_combobox.Text = "" Then
GetUserFormOfControl(m_combobox).Picture = Nothing
Else
With GetUserFormOfControl(m_combobox)
.Picture = LoadPicture(ThisWorkbook.Path & "\Images\BackgroundImages\" & m_combobox.Text)
.PictureSizeMode = fmPictureSizeModeStretch
End With
End If
End If
End Sub
Public Sub AssignComboBox(c As MSForms.ComboBox)
Set m_combobox = c
End Sub
So the combo box added to the user form by the line AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage Me
failed to work as expected. How it should be resolved?
EventHandlerCollection
goes out of scope and is destroyed as soon as AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage
exits, so it's not around to handle any events.
You need to make that collection a Global variable so it stays in scope after the sub which populates it exits.
Dim EventHandlerCollection As Collection 'global so stays in scope
Public Function AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage( _
frm As MSForms.UserForm)
Dim CmbBox As MSForms.Control, cmbeventhandler As CtrlEvents
Set EventHandlerCollection = New Collection
Set CmbBox = frm.Controls.Add("Forms.ComboBox.1", "cmbBackgroundImage")
Set cmbeventhandler = New CtrlEvents
cmbeventhandler.AssignComboBox CmbBox
EventHandlerCollection.Add cmbeventhandler