Question

我在向类模块分配VBA生成的ActiveX复选框时遇到问题。当用户点击按钮时，我想要实现的目标是：1 - 删除Excel工作表上的所有复选框;第二 - 自动生成一堆复选框;第3步 - 为这些新的复选框分配一个类模块，这样当用户随后单击其中一个时，类模块就会运行。

我从以前的帖子Make vba code work for all boxes

中大量借用

我遇到的问题是第3个例程（将类模块分配给新的复选框）在前2个例程之后运行时不起作用。如果在创建复选框后单独运行，它运行正常。从我能说的最好的情况来看，VBA似乎没有发布＆＃34;创建它们后的复选框以允许分配类模块。

以下代码是演示此问题的简化代码。在这段代码中，我在＆＃34; Sheet1＆＃34;上使用了一个按钮。运行Sub RunMyCheckBoxes（）。单击按钮1时，类模块未分配给新生成的复选框。我在＆＃34; Sheet1＆＃34;上使用按钮2运行Sub RunAfter（）。如果在单击按钮1后单击按钮2，则复选框将分配给类模块。如果只点击第一个按钮，我无法弄清楚为什么不会分配课程模块。请帮助。

模块1：公共mcolEvents As Collection

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

更新：在进一步的研究中，这里有一个解决方案： Creating events for checkbox at runtime Excel VBA

显然你需要强制Excel VBA现在按时运行： Application.OnTime Now＆＃34;＆＃34;

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

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

Answer 1

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

但是，您是否知道Excel的Checkbox对象可以使这项任务变得更加简单......而且速度更快？它的简单性在于您可以轻松地迭代Checkboxes集合并且可以访问其.OnAction属性。也很容易识别发件人＆＃39;通过利用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将所有复选框分配给类模块

1 个答案: