将相同的代码添加到多个组合框中

Question

我有一个包含960个组合框的工作表。我需要它们都附有相同的代码：

Private Sub ComboBox1_DropButtonClick()
ActiveSheet.Range("a2").Select
End Sub

有没有办法将这些代码自动附加到工作表上的每个组合框中，而无需一个一个地执行它的繁琐工作？如果它很重要，我附加此代码的原因是因为当选择组合框时，工作表上的超链接和代码将无法工作，直到/除非用户单击任何单元格。如果有一个属性设置来处理这个问题，那么我宁愿这样做。

Answer 1

创建ComboBox集合

你需要

• 自定义类ComboWrapper以保存对您的组合框的引用
  • 使用WithEvents，您将捕获Click事件
  按钮
• 模块级别集合变量，用于保存对内存中ComboWrapper的引用
  • 使用Worksheet_Activate()实例化集合

插入课程

重命名ComboWrapper

将此代码插入ComboWrapper类

Public WithEvents combo As MSForms.ComboBox

Private Sub combo_Change()

    Range("A2").Select

End Sub

将此代码插入Worksheet Code Module

Public ComboCollection As Collection

Private Sub Worksheet_Activate()
    Dim o As OLEObject
    Dim wrapper As ComboWrapper
    Set ComboCollection = New Collection

    For Each o In ActiveSheet.OLEObjects
        On Error Resume Next

        If o.progID = "Forms.ComboBox.1" Then
            Set wrapper = New ComboWrapper
            Set wrapper.combo = o.Object

            ComboCollection.Add wrapper
        End If

        On Error GoTo 0
    Next

End Sub

Answer 2

由于您使用ActiveX控件，因此预先指定了子名称。例如：如果您点击ComboBox1，则子的名称必须为Private Sub ComboBox1_DropButtonClick()，子必须位于表单上ComboBox位于。所以，如果你有960个ComboBox，那么你需要在这些ComboBox所在的工作表上有960个子组件。

但这是个好消息。您可以使用VBA为您编写VBA代码。以下sub将遍历所有工作表和所有ActiveX组合框并为您编写代码。然后，代码将被放入VBE的Immediate窗口。

Option Explicit

Public Sub GenerateComboBoxCode()

Dim ws As Worksheet
Dim obj As OLEObject
Dim strVBA As String

For Each ws In ThisWorkbook.Worksheets
    For Each obj In ws.OLEObjects
        If TypeName(obj.Object) = "ComboBox" Then
            strVBA = strVBA & "Private Sub " & obj.Name & "_DropButtonClick() " & Chr(10)
            strVBA = strVBA & "ActiveSheet.Range(""a2"").Select " & Chr(10)
            strVBA = strVBA & "End Sub " & Chr(10)
        End If
    Next obj
    Debug.Print "------------------------------------------------------"
    Debug.Print "--- Code for sheet " & ws.Name & ":"
    Debug.Print "------------------------------------------------------"
    Debug.Print strVBA
Next ws

End Sub

但是在你的情况下（960 ComboBoxes），Immediate窗口可能不够，你可能不得不将VBA代码存储/保存在工作表上。

更新

由于Immediate窗口无法适合整个代码，因此以上解决方案稍作更新：

Option Explicit

Public Sub GenerateComboBoxCode()

Dim ws As Worksheet
Dim obj As OLEObject
Dim strVBA As String
Dim appWord As Object
Dim docWord As Object

For Each ws In ThisWorkbook.Worksheets
    strVBA = strVBA & "------------------------------------------------------" & Chr(10)
    strVBA = strVBA & "--- Code for sheet " & ws.Name & ":" & Chr(10)
    strVBA = strVBA & "------------------------------------------------------" & Chr(10)
    For Each obj In ws.OLEObjects
        If TypeName(obj.Object) = "ComboBox" Then
            strVBA = strVBA & "Private Sub " & obj.Name & "_DropButtonClick() " & Chr(10)
            strVBA = strVBA & "ActiveSheet.Range(""a2"").Select " & Chr(10)
            strVBA = strVBA & "End Sub " & Chr(10)
        End If
    Next obj
Next ws

Set appWord = CreateObject("Word.Application")
Set docWord = appWord.Documents.Add
docWord.Paragraphs.Add
docWord.Paragraphs(docWord.Paragraphs.Count).Range.Text = strVBA
appWord.Visible = True

End Sub

现在，创建了一个新的Word Document，并将整个代码复制到该word文档中。之后，您可以复制所有文档的内容并将其粘贴到ComboBox所在的工作表中。