如何为所有ActiveX标签应用相同VBA？复制标签时保留VBA方法

方案一：复制标签时连带生成适配的VBA代码 #

直接复制ActiveX标签控件不会自动生成对应的Click事件代码，你可以按以下两种方式处理：

手动适配（少量标签适用） #

1. 复制Label1得到新标签（如Label2、Label3）后，打开对应工作表的VBA模块
2. 手动添加每个新标签的Click事件代码，将原代码中的Label1替换为新标签名称：

Private Sub Label2_Click()
    If Label2.Caption = Chr(254) Then
        Label2.Caption = Chr(168)
    Else
        Label2.Caption = Chr(254)
    End If
End Sub

批量生成代码（多标签适用） #

如果需要大量标签，可运行以下代码自动为工作表所有ActiveX标签生成Click事件代码：

Sub GenerateLabelClickCodes()
    Dim ws As Worksheet
    Dim ctl As OLEObject
    Dim codeModule As CodeModule
    Dim lineNum As Integer
    
    Set ws = ActiveSheet
    Set codeModule = ws.CodeModule
    
    ' 遍历工作表所有ActiveX控件
    For Each ctl In ws.OLEObjects
        ' 判断是否为Label控件
        If TypeName(ctl.Object) = "Label" Then
            ' 检查是否已存在对应事件代码
            On Error Resume Next
            codeModule.ProcStartLine "Private Sub " & ctl.Name & "_Click()", vbext_pk_Proc
            If Err.Number <> 0 Then
                ' 不存在则插入代码
                lineNum = codeModule.CountOfLines + 1
                codeModule.InsertLines lineNum, "Private Sub " & ctl.Name & "_Click()"
                codeModule.InsertLines lineNum + 1, "    If " & ctl.Name & ".Caption = Chr(254) Then"
                codeModule.InsertLines lineNum + 2, "        " & ctl.Name & ".Caption = Chr(168)"
                codeModule.InsertLines lineNum + 3, "    Else"
                codeModule.InsertLines lineNum + 4, "        " & ctl.Name & ".Caption = Chr(254)"
                codeModule.InsertLines lineNum + 5, "    End If"
                codeModule.InsertLines lineNum + 6, "End Sub"
            End If
            On Error GoTo 0
        End If
    Next ctl
End Sub

运行此代码后，所有ActiveX标签都会自动生成对应的点击切换代码。

方案二：使用类模块统一处理所有标签 #

这种方法无需为每个标签单独写代码，通过类模块实现批量控制：

1. 打开VBA编辑器，插入一个类模块，将其命名为clsLabelCheckbox
2. 在clsLabelCheckbox模块中写入以下代码：

Public WithEvents chkLabel As MSForms.Label

Private Sub chkLabel_Click()
    If chkLabel.Caption = Chr(254) Then
        chkLabel.Caption = Chr(168)
    Else
        chkLabel.Caption = Chr(254)
    End If
End Sub

3. 打开对应工作表的VBA模块，写入以下代码：

Dim labelCollection As New Collection

Private Sub Worksheet_Activate()
    Dim ctl As OLEObject
    Dim clsLabel As clsLabelCheckbox
    
    ' 清空集合避免重复绑定
    Set labelCollection = New Collection
    
    ' 遍历所有ActiveX标签并绑定到类
    For Each ctl In Me.OLEObjects
        If TypeName(ctl.Object) = "Label" Then
            Set clsLabel = New clsLabelCheckbox
            Set clsLabel.chkLabel = ctl.Object
            labelCollection.Add clsLabel
        End If
    Next ctl
End Sub

完成以上设置后，工作表内所有ActiveX标签被点击时，都会自动切换Chr(254)和Chr(168)的状态，后续新增的ActiveX标签，只要激活工作表就会自动生效。

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