vbadynamic-controls

VBA Dynamically added combo box does not trigger change event


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?


Solution

  • 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