如何将带事件代码的ActiveX ComboBox自动复制到Excel所有工作表

方案2：统一公共代码调用（更推荐，无需逐个工作表写入代码） #

该方案后续修改逻辑只需要调整一处代码，维护成本远低于逐表写入。

实现步骤 #

1. 打开VBA编辑器，右键点击当前工作簿，选择「插入」→「类模块」，将类模块重命名为clsSheetCombobox，写入以下代码：

Public WithEvents cbo As MSForms.ComboBox

' 所有工作表的组合框共用该跳转逻辑
Private Sub cbo_Change()
    Dim targetSheetName As String
    targetSheetName = Me.cbo.Value
    ' 校验工作表存在性，避免非法值报错
    On Error Resume Next
    ThisWorkbook.Sheets(targetSheetName).Activate
    On Error GoTo 0
End Sub

2. 再次右键点击工作簿，选择「插入」→「模块」，在标准模块中写入全局变量声明，避免绑定的事件丢失：

' 存储所有工作表的组合框实例
Public colComboboxes As New Collection

3. 打开ThisWorkbook模块，在Workbook_SheetActivate事件中补充控件复制+事件绑定逻辑：

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim cbo As OLEObject
    Dim cboInstance As clsSheetCombobox
    
    ' 清除当前工作表已有的同名组合框，避免重复创建
    On Error Resume Next
    Sh.OLEObjects("ComboBox1").Delete
    On Error GoTo 0
    
    ' 从Sheet1复制源组合框到当前激活工作表
    ThisWorkbook.Sheets("Sheet1").OLEObjects("ComboBox1").Copy
    Sh.Paste
    Selection.Name = "ComboBox1" ' 保持控件名统一
    
    ' 绑定组合框事件到公共类
    Set cbo = Sh.OLEObjects("ComboBox1")
    Set cboInstance = New clsSheetCombobox
    Set cboInstance.cbo = cbo.Object
    colComboboxes.Add cboInstance
End Sub

方案1：自动批量写入代码到所有工作表模块 #

注意：使用该方案需要先开启权限：Excel选项→信任中心→信任中心设置→宏设置→勾选「信任对VBA项目对象模型的访问」。

实现步骤 #

在标准模块中运行以下代码，即可自动给所有工作表写入跳转事件：

Sub BatchAddJumpCodeToSheets()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    Dim codeMod As Object
    Dim codeTemplate As String
    
    ' 跳转事件代码模板
    codeTemplate = "Private Sub ComboBox1_Change()" & vbCrLf & _
                   "    Dim targetName As String: targetName = Me.ComboBox1.Value" & vbCrLf & _
                   "    On Error Resume Next" & vbCrLf & _
                   "    ThisWorkbook.Sheets(targetName).Activate" & vbCrLf & _
                   "    On Error GoTo 0" & vbCrLf & _
                   "End Sub"
    
    For Each ws In wb.Worksheets
        Set codeMod = wb.VBProject.VBComponents(ws.CodeName).CodeModule
        ' 先删除已有的同名事件，避免代码重复
        Dim startLine As Long
        On Error Resume Next
        startLine = codeMod.ProcStartLine("ComboBox1_Change", 0)
        If Err.Number = 0 Then
            codeMod.DeleteLines startLine, codeMod.ProcCountLines("ComboBox1_Change", 0)
        End If
        On Error GoTo 0
        ' 写入新的跳转代码
        codeMod.AddFromString codeTemplate
    Next ws
    MsgBox "所有工作表代码写入完成"
End Sub

内容的提问来源于stack exchange，提问作者Shawn V. Wilson