VBA 动态添加组合框不触发变化事件

Question

我有一个代码可以在运行时在用户表单中添加一个组合框。组合框包含文件夹中的图像名称列表。当用户 select 图片命名时，它会将图片设置为用户表单的背景图片。但是动态组合框只更改背景图像一次，即下面代码中的 UserForm_Initialize 事件，而我在设计中添加的组合框完美运行，即只要组合框值更改，就会更改用户表单的背景。

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

模块 1

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

因此，通过行 AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage Me 添加到用户表单的组合框未能按预期工作。应该怎么解决？

Answer 1

EventHandlerCollection 超出范围并在 AddBackgroundChangeComboBoxAndSetPreferredBackgroundImage 退出后立即销毁，因此它无法处理任何事件。

您需要将该集合设置为全局变量，以便它在填充它的子程序退出后保留在范围内。

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

VBA 动态添加组合框不触发变化事件

VBA Dynamically added combo box does not trigger change event

vba

dynamic-controls