捕获动态创建的CommandButton控件的点击事件异常问题

我有一个工作表，其中多个表头需要基于另一工作表的列表调整；但受工作簿内其他代码限制，无法用数据验证实现该功能。我创建了一个UserForm，从Formatting工作表获取列表，动态生成CommandButton，为列表每个条目创建按钮并在窗体内布局。预期效果：点击按钮时关闭窗体，将报表工作表的活动表头单元格值改为按钮Caption，同时列的OnChange事件会根据新表头更新列内所有数据。

目前问题：代码运行正常，但调用Class1模块绑定按钮点击事件的部分被直接跳过，无任何报错，点击事件完全不生效。相关代码如下：

工作表事件代码 #

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    If Not Application.Intersect(Target, Range("B2:ZZ2")) Is Nothing Then
        HeadersForm.Show
    End If
    
    ActiveSheet.Cells(1, 1).Select

End Sub


Private Sub UserForm_Activate()
    Dim ws As Worksheet
    Dim dataColumn As Range
    Dim cell As Range
    Dim CommandButton As MSForms.CommandButton
    Dim totalCommandButtons As Integer
    Dim CommandButtonsPerColumn As Integer
    Dim numRows As Integer
    Dim numColumns As Integer
    Dim buttonWidth As Integer
    Dim buttonHeight As Integer
    Dim leftMargin As Integer
    Dim topMargin As Integer
    Dim rowSpacing As Integer
    Dim colSpacing As Integer
    Dim i As Integer
    Dim j As Integer

    Set ws = ThisWorkbook.Worksheets("Formatting")

    i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set dataColumn = ws.Range("A2:A" & i)

    totalCommandButtons = dataColumn.Cells.Count
    CommandButtonsPerColumn = 4

    numRows = (totalCommandButtons + CommandButtonsPerColumn - 1) \ CommandButtonsPerColumn
    numColumns = Application.Min(CommandButtonsPerColumn, totalCommandButtons)

    Me.StartUpPosition = 0
    Me.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Me.Width)
    Me.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)
    
    
    buttonWidth = 100
    buttonHeight = 20
    leftMargin = 10
    topMargin = 10
    rowSpacing = 5
    colSpacing = 5

    Me.Width = leftMargin + numColumns * (buttonWidth + colSpacing) - colSpacing + 2 * leftMargin
    Me.Height = topMargin + numRows * (buttonHeight + rowSpacing) - rowSpacing + 2 * topMargin + 15

    For Each cell In dataColumn.Cells
        If Not IsEmpty(cell.Value) Then
            Set CommandButton = Me.Controls.Add("Forms.CommandButton.1", "CommandButton_" & cell.Row - 1)
            CommandButton.Caption = cell.Value
            CommandButton.Width = buttonWidth
            CommandButton.Height = buttonHeight

            With CommandButton
                .Left = leftMargin + ((cell.Row - 2) Mod CommandButtonsPerColumn) * (buttonWidth + colSpacing)
                .Top = topMargin + ((cell.Row - 2) \ CommandButtonsPerColumn) * (buttonHeight + rowSpacing)
            End With

            SetCommandClickEvent CommandButton
        End If
    Next cell
End Sub

绑定事件的子过程 #

Private Sub SetCommandClickEvent(btn As MSForms.CommandButton)

    Set CommandButtonEventHandler = New Class1
    Set CommandButtonEventHandler.CommandButton = btn
    
End Sub

Class1类模块代码 #

Public WithEvents CommandButton As MSForms.CommandButton

Private Sub CommandButton_Click()

    If CommandButton.Value = True Then
        ActiveCell.Value = CommandButton.Caption
    End If
    
        HeadersForm.Hide

End Sub

核心问题 #

CommandButtonEventHandler是局部变量，SetCommandClickEvent过程执行完毕后，变量会被销毁，类实例与按钮的关联被切断，导致点击事件无法触发。

修复步骤 #

1. 在UserForm模块顶部声明全局集合，保存所有类实例引用，避免被垃圾回收：

   Dim btnEventHandlers As New Collection
   

2. 修改SetCommandClickEvent过程，将类实例存入集合：

   Private Sub SetCommandClickEvent(btn As MSForms.CommandButton)
       Dim handler As New Class1
       Set handler.CommandButton = btn
       btnEventHandlers.Add handler
   End Sub
   

3. 优化Class1的点击事件逻辑（可选但更可靠）：
   无需判断CommandButton.Value = True，直接设置单元格值，同时建议传递目标单元格替代ActiveCell：

   Public WithEvents CommandButton As MSForms.CommandButton
   Public TargetCell As Range
   
   Private Sub CommandButton_Click()
       If Not TargetCell Is Nothing Then
           TargetCell.Value = CommandButton.Caption
       End If
       HeadersForm.Hide
   End Sub
   

4. 传递目标单元格到类实例（可选优化）：
   在UserForm模块添加模块级变量：

   Dim targetHeaderCell As Range
   

   修改工作表双击事件：

   Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
       If Not Application.Intersect(Target, Range("B2:ZZ2")) Is Nothing Then
           Cancel = True ' 取消默认双击行为
           Set targetHeaderCell = Target
           HeadersForm.Show
       End If
   End Sub
   

   更新SetCommandClickEvent过程：

   Private Sub SetCommandClickEvent(btn As MSForms.CommandButton)
       Dim handler As New Class1
       Set handler.CommandButton = btn
       Set handler.TargetCell = targetHeaderCell
       btnEventHandlers.Add handler
   End Sub
   

修改完成后，类实例会被集合持续引用，点击事件即可正常触发，同时避免ActiveCell带来的不确定性。

内容的提问来源于stack exchange，提问作者Hareborn