Excel VBA如何链接一个类和一个控件？

Question

我正在使用带有 VBA 的 Excel 2003，我在工作表上动态创建复选框控件，并希望将 VBA 控件链接到一个类，以便当用户单击复选框时会触发一个事件，以便我可以执行某些操作。

从我读到的内容来看，创建用户类似乎是解决方案，但尝试过之后我无法让它工作。

我的用户类别如下所示:

    Option Explicit

    Public WithEvents cbBox As MSForms.checkbox

    Private Sub cbBox_Change()
        MsgBox "_CHANGE"
    End Sub

    Private Sub cbBox_Click()
        MsgBox "_CLICK"
    End Sub

我创建复选框的代码:

    For Each varExisting In objColumns
    'Insert the field name
        objColumnHeadings.Cells(lngRow, 1).Value = varExisting
    'Insert a checkbox to allow selection of the column
        Set objCell = objColumnHeadings.Cells(lngRow, 2)
        Dim objCBclass As clsCheckbox
        Set objCBclass = New clsCheckbox
        Set objCBclass.cbBox = ActiveSheet.OLEObjects.Add( _
                                  ClassType:="Forms.CheckBox.1" _
                                , Left:=300 _
                                , Top:=(objCell.Top + 2) _
                                , Height:=10 _
                                , Width:=9.6).Object
        objCBclass.cbBox.Name = "chkbx" & lngRow
        objCBclass.cbBox.Caption = ""
        objCBclass.cbBox.BackColor = &H808080
        objCBclass.cbBox.BackStyle = 0
        objCBclass.cbBox.ForeColor = &H808080
        objCheckboxes.Add objCBclass
        lngRow = lngRow + 1
    Next

这些复选框在工作表中可见，但是当我单击它们时，没有显示消息框，因此指向该类的链接似乎不起作用。

为什么？

编辑...如果添加复选框后我进入 VB IDE 并从控件列表中选择创建的复选框之一，然后从“过程”下拉列表中选择“单击”，它将插入回调代码如果我向其中添加一个消息框，当我单击同一个复选框时，它就会起作用......那么我如何在代码中实现这一点呢？我尝试录制宏来执行此操作，但没有录制任何内容。

Answer 1

由 S.Platten 编辑，跳到底部了解这如何帮助我解决问题...

由于某些奇怪的原因，VBA 不会在添加事件的同一执行周期中连接 Sheet 的 ActiveX 控件的事件。因此，我们需要跳出添加控件的循环，然后在下一个循环中调用事件添加过程。 Application.OnTime 在这里有帮助。

这似乎有点矫枉过正，但它确实有效:)

Option Explicit

 Dim collChk         As Collection
 Dim timerTime

 Sub master()

        '/ Add the CheckBoxes First
        Call addControls

        '<< Due to some weird reason, VBA doesn't hook up the events for Sheet's ActiveX control in the same
        'execution cycle in which they were added. So, we need to come out of the cycle which added the controls
        'and then invoke the event adding proc in next cycle. >>

        '/ Start Timer. Timer will call the sub to add the events
        Call StartTimer
 End Sub

Sub addControls()
    Dim ctrlChkBox      As MSForms.CheckBox
    Dim objCell         As Range
    Dim i               As Long

    'Intialize the collection to hold the classes
    Set collChk = New Collection

    '/ Here Controls are added. No Events, yet.
    For i = 1 To 10
        Set objCell = Sheet1.Cells(i, 1)
        Set ctrlChkBox = Sheet1.OLEObjects.Add( _
                          ClassType:="Forms.CheckBox.1" _
                        , Left:=1 _
                        , Top:=(objCell.Top + 2) _
                        , Height:=objCell.Height _
                        , Width:=100).Object
        ctrlChkBox.Name = "chkbx" & objCell.Row
     Next

End Sub

Sub addEvents()

    Dim ctrlChkBox      As MSForms.CheckBox
    Dim objCBclass      As clsCheckBox
    Dim x               As Object


    'Intialize the collection to hold the classes
    Set collChk = New Collection

    '/ Here we assign the event handler
     For Each x In Sheet1.OLEObjects
       If x.OLEType = 2 Then

        Set ctrlChkBox = x.Object

        Set objCBclass = New clsCheckBox
        Set objCBclass.cbBox = ctrlChkBox

        collChk.Add objCBclass
        Debug.Print x.Name
       End If
    Next

    '/ Kill the timer
    Call StopTimer

End Sub

Sub StartTimer()
    timerTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _
        Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _
        Schedule:=False
End Sub

类模块:clsCheckBox

    Option Explicit

    Public WithEvents cbBox As MSForms.CheckBox

    Private Sub cbBox_Change()
        MsgBox "_CHANGE"
    End Sub

    Private Sub cbBox_Click()
        MsgBox "_CLICK"
    End Sub

编辑继续...

类(clsCheckbox):

    Option Explicit

    Public WithEvents cbBox As MSForms.checkbox

    Private Sub cbBox_Click()
        MsgBox "_CLICK"
    End Sub

模块1

    Public objCheckboxes As Collection
    Public tmrTimer

    Public Sub addEvents()
        Dim objCheckbox As clsCheckbox
        Dim objMSCheckbox As Object
        Dim objControl As Object

        Set objCheckboxes = New Collection
        For Each objControl In Sheet1.OLEObjects
            If objControl.OLEType = 2 _
            And objControl.progID = "Forms.CheckBox.1" Then
                Set objMSCheckbox = objControl.Object
                Set objCheckbox = New clsCheckbox
                Set objCheckbox.cbBox = objMSCheckbox
                objCheckboxes.Add objCheckbox
            End If
        Next
        Call stopTimer
    End Sub

    Public Sub startTimer()
        tmrTimer = Now + TimeSerial(0, 0, 1)
        Application.OnTime EarliestTime:=tmrTimer _
                         , Procedure:="addEvents" _
                         , Schedule:=True
    End Sub

    Public Sub stopTimer()
        On Error Resume Next
        Application.OnTime EarliestTime:=tmrTimer _
                         , Procedure:="addEvents" _
                         , Schedule:=False
    End Sub

工作表中添加控件的代码:

    Dim objControl As MSForms.checkbox
    For Each varExisting In objColumns
    'Insert the field name
        objColumnHeadings.Cells(lngRow, 1).Value = varExisting
    'Insert a checkbox to allow selection of the column
        Set objCell = objColumnHeadings.Cells(lngRow, 2)
        Set objControl = ActiveSheet.OLEObjects.Add( _
                                  ClassType:="Forms.CheckBox.1" _
                                , Left:=300 _
                                , Top:=(objCell.Top + 2) _
                                , Height:=10 _
                                , Width:=9.6).Object
        objControl.Name = "chkbx" & lngRow
        objControl.Caption = ""
        objControl.BackColor = &H808080
        objControl.BackStyle = 0
        objControl.ForeColor = &H808080
        lngRow = lngRow + 1
    Next

这不是整个项目，但足以演示其工作原理。