Excel 使用VBA将所有复选框指定给类模块

将VBA生成的ActiveX复选框分配给类模块时遇到问题。当用户单击一个按钮时，我试图实现的目标是：1-删除excel工作表上的所有复选框；第二，自动生成一组复选框；第三-为这些新复选框分配一个类模块，这样当用户随后单击其中一个复选框时，类模块将运行

我从以前的帖子里借了很多

我遇到的问题是，第三个例程（将类模块分配给新复选框）在随后运行到前两个例程时不起作用。如果在创建复选框后独立运行，则运行正常。据我所知，VBA似乎没有在创建复选框后“释放”复选框，以允许分配类模块

下面的代码是演示此问题的简化代码。在这段代码中，我使用“Sheet1”上的一个按钮来运行子runmycheckbox（）。单击按钮1时，未将类模块分配给新生成的复选框。我使用“Sheet1”上的按钮2运行Sub RunAfter（）。如果在单击按钮1后单击按钮2，则复选框将分配给类模块。我不明白为什么只要单击第一个按钮，类模块就不会被分配。请帮忙

模块1： 公共mcolEvents作为集合

Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
    Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
    Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Call SetCBAction("Sheet1")
End Sub

Sub DeleteAllCheckboxesOnSheet(SheetName As String)
Dim obj As OLEObject
For Each obj In Sheets(SheetName).OLEObjects
    If TypeOf obj.Object Is MSForms.CheckBox Then
        obj.Delete
    End If
Next
End Sub

Sub InsertCheckBoxes(SheetName As String, CellRow As Double, CellColumn As Double, CBName As String)
Dim CellLeft As Double
Dim CellWidth As Double
Dim CellTop As Double
Dim CellHeight As Double
Dim CellHCenter As Double
Dim CellVCenter As Double

CellLeft = Sheets(SheetName).Cells(CellRow, CellColumn).Left
CellWidth = Sheets(SheetName).Cells(CellRow, CellColumn).Width
CellTop = Sheets(SheetName).Cells(CellRow, CellColumn).Top
CellHeight = Sheets(SheetName).Cells(CellRow, CellColumn).Height
CellHCenter = CellLeft + CellWidth / 2
CellVCenter = CellTop + CellHeight / 2
With Sheets(SheetName).OLEObjects.Add(classtype:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=CellHCenter - 8, Top:=CellVCenter - 8, Width:=16, Height:=16)
    .Name = CBName
    .Object.Caption = ""
    .Object.BackStyle = 0
    .ShapeRange.Fill.Transparency = 1#
End With
End Sub

Sub SetCBAction(SheetName)
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets(SheetName).OLEObjects
    If TypeName(o.Object) = "CheckBox" Then
        Set cCBEvents = New clsActiveXEvents
        Set cCBEvents.mCheckBoxes = o.Object
        mcolEvents.Add cCBEvents
    End If
Next
End Sub


Sub RunAfter()
Call SetCBAction("Sheet1")
End Sub

类模块（clsActiveXEvents）： 选项显式

Public WithEvents mCheckBoxes As MSForms.CheckBox

Private Sub mCheckBoxes_click()
MsgBox "test"
End Sub

更新： 在进一步研究中，下面的答案中有一个解决方案：

显然，您现在需要强制Excel VBA按时运行： Application.OnTime Now“”

用于解决此问题的已编辑代码行：

Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
    Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
    Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Application.OnTime Now, "SetCBAction" '''This is the line that changed
End Sub

使用这种新格式：

Sub SetCBAction() ''''no longer passing sheet name with new format
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets("Sheet1").OLEObjects '''''No longer passing sheet name with new format
    If TypeName(o.Object) = "CheckBox" Then
        Set cCBEvents = New clsActiveXEvents
        Set cCBEvents.mCheckBoxes = o.Object
        mcolEvents.Add cCBEvents
    End If
Next
End Sub

---

如果OLE对象适合您的需要，那么我很高兴您找到了解决方案

但是，您是否知道Excel的

复选框

对象可以使此任务变得相当简单。。。更快？它的简单性在于，您可以轻松地迭代

复选框

集合，并且可以访问其

.OnAction

属性。利用

Evaluate

功能也可以轻松识别“发送者”。如果您需要定制它的外观，它具有一些格式化功能

如果您想要快速简单的任务，下面的示例将让您了解如何将整个任务编成代码：

Public Sub RunMe()
    Const BOX_SIZE As Integer = 16
    Dim ws As Worksheet
    Dim cell As Range
    Dim cbox As CheckBox
    Dim i As Integer, j As Integer
    Dim boxLeft As Double, boxTop As Double

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'Delete checkboxes
    For Each cbox In ws.CheckBoxes
        cbox.Delete
    Next

    'Add checkboxes
    For i = 1 To 10
        For j = 1 To 2
            Set cell = ws.Cells(i, j)
            With cell
                boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
                boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
            End With
            Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
            With cbox
                .Name = "CB" & i & j
                .Caption = ""
                .OnAction = "CheckBox_Clicked"
            End With
        Next
    Next
End Sub
Sub CheckBox_Clicked()
    Dim sender As CheckBox

    Set sender = Evaluate(Application.Caller)
    MsgBox sender.Name & " now " & IIf(sender.Value = 1, "Checked", "Unchecked")
End Sub

---

如果OLE对象适合您的需要，那么我很高兴您找到了解决方案

但是，您是否知道Excel的

复选框

对象可以使此任务变得相当简单。。。更快？它的简单性在于，您可以轻松地迭代

复选框

集合，并且可以访问其

.OnAction

属性。利用

Evaluate

功能也可以轻松识别“发送者”。如果您需要定制它的外观，它具有一些格式化功能

如果您想要快速简单的任务，下面的示例将让您了解如何将整个任务编成代码：

Public Sub RunMe()
    Const BOX_SIZE As Integer = 16
    Dim ws As Worksheet
    Dim cell As Range
    Dim cbox As CheckBox
    Dim i As Integer, j As Integer
    Dim boxLeft As Double, boxTop As Double

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'Delete checkboxes
    For Each cbox In ws.CheckBoxes
        cbox.Delete
    Next

    'Add checkboxes
    For i = 1 To 10
        For j = 1 To 2
            Set cell = ws.Cells(i, j)
            With cell
                boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
                boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
            End With
            Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
            With cbox
                .Name = "CB" & i & j
                .Caption = ""
                .OnAction = "CheckBox_Clicked"
            End With
        Next
    Next
End Sub
Sub CheckBox_Clicked()
    Dim sender As CheckBox

    Set sender = Evaluate(Application.Caller)
    MsgBox sender.Name & " now " & IIf(sender.Value = 1, "Checked", "Unchecked")
End Sub

---

在另一篇文章中找到了解决方案。用解决方案编辑了上面的原始帖子。显然，现在需要强制VBA按时运行“Application.OnTime now”哈哈，我自己刚想出来。问题是Ole Server正在VBA之外创建控件。这对我来说没有多大意义，我以前会尝试使用

DoEvents

，让Excel完成它的工作。OLE对象相当慢。您还可以在创建对象时设置集合和类事件，而不是在以下操作之后执行：

With Sheets（SheetName）.OLEObjects.Add（…）：set cCBEvents.mcheckbox=.object

，等等？谢谢你，托马斯。这背后的“为什么”很有帮助，因此我知道如何避免再次遇到它：）在另一篇文章中找到了解决方案。用解决方案编辑了上面的原始帖子。显然，现在需要强制VBA按时运行“Application.OnTime now”哈哈，我自己刚想出来。问题是Ole Server正在VBA之外创建控件。这对我来说没有多大意义，我以前会尝试使用

DoEvents

，让Excel完成它的工作。OLE对象相当慢。您还可以在创建对象时设置集合和类事件，而不是在以下操作之后执行：

With Sheets（SheetName）.OLEObjects.Add（…）：set cCBEvents.mcheckbox=.object

，等等？谢谢你，托马斯。这背后的“为什么”很有帮助，所以我知道如何避免再次遇到它：）谢谢Ambie。据我所见，ActiveX控件提供了比表单控件更多的接口选项。基于这种需要，我选择了ActiveX路线。谢谢Ambie。据我所见，ActiveX控件提供了比表单控件更多的接口选项。基于这种需要，我选择了ActiveX路由。