在 VBA 中选中任何复选框时的事件触发答案

【问题标题】：Event trigger when any checkbox is checked在 VBA 中选中任何复选框时的事件触发
【发布时间】：2022-01-26 17:11:15
【问题描述】：

我有一个工作表，其中列出了工厂等待交付的汽车零件。我需要做的是在每个单元格中使用复选框填充 I 列。我创建了一个名为“CREATE CHECKBOXES”的按钮，它基本上查看存在多少行数据，然后使用从 CheckBox1 到 CheckboxN 的 ActiveX 复选框填充 I 列的每个单元格（n = 包含数据的行数）。那部分已经想通了。接下来必须发生的是：当用户选中任何一个复选框时，它必须弹出一个用户表单，其中包含 2 个数据字段输入，这些输入将插入到选中复选框的同一行的 J 和 K 列上。我卡在代码中的地方是当任何复选框被选中时触发用户窗体弹出的事件。我在这个社区（链接：Event triggered by ANY checkbox click）上看到了一篇文章，对我有一点帮助，但现在由于代码将复选框计算为形状，我无法添加任何类型的按钮来向其添加宏（我必须删除“创建复选框”按钮），否则链接帖子中的代码将不起作用。那么，如何在检查和维护形状按钮时，如何使此UserForm触发事件发生此操作？在那之后肯定会发生一些事情，但我想我可以处理它而不会太头疼。这是我到目前为止所做的： -> 使用此代码创建了一个类模块：

' put all this code in class a module and name the class module "ChkClass"

Option Explicit

Public WithEvents ChkBoxGroup As MSForms.CheckBox

Private Sub ChkBoxGroup_Change()
    Debug.Print "ChkBoxGroup_Change"
End Sub

并将其命名为 ChkClass。然后将其粘贴到工作表代码中：


Private Sub Worksheet_Activate()
    activateCheckBoxes
End Sub

在那之后，我创建了一个模块，它从链接的帖子中略有改编：


Option Explicit

Dim CheckBoxes() As New ChkClass

'

Sub doCheckBoxes()
    makeCheckBoxes
    activateCheckBoxes
End Sub

Sub makeCheckBoxes()
Sheets(2).Select
    Dim c As Range
    Dim ultlinha As Integer
ultlinha = Range("A2").End(xlDown).Row
Range(Cells(2, 9), Cells(ultlinha, 9)).Select

For Each c In Selection

With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=c.Left, Top:=c.Top, Width:=c.Width, Height:=c.Height)
     DoEvents
     .Object.Caption = "FATURADO"
            .LinkedCell = c.Offset(0, 3).Address
            .Object.Value = 0    'sets checkbox to false
            .Object.Font.Name = "Calibri"
            .Object.Font.Size = 9
            .Object.Font.Italic = True
            .Object.BackStyle = fmBackStyleTransparent
End With
Next



Range("a1").Select
End Sub

Sub activateCheckBoxes()       ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup

    Dim sht As Worksheet
    Set sht = ActiveSheet

    ReDim CheckBoxes(1 To 1)

    Dim i As Integer
    For i = 1 To sht.Shapes.Count

        ReDim Preserve CheckBoxes(1 To i)

        Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object

    Next i

End Sub

问题恰恰出在这一行： Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object 如果工作表中没有其他按钮或形状，则它运行顺畅且完美。但是，如果我添加一个按钮或表单来添加宏，它就不起作用。我真的希望有人可以在这里有所启发。谢谢。

【问题讨论】：

标签： excel vba checkbox event-handling

【解决方案1】：

如果您只想“激活”复选框，则可以遍历工作表的 OLEObjects 集合并仅捕获复选框。

Sub activateCheckBoxes()      

    Dim sht As Worksheet, obj As OLEObject, n As Long
    Set sht = ActiveSheet

    ReDim CheckBoxes(1 To 1)

    Dim i As Integer
    For Each obj In sht.OLEObjects
        If TypeName(obj.Object) = "CheckBox" Then  'is a checkbox?
            n = n + 1
            If n > 1 Then ReDim Preserve CheckBoxes(1 To n)
            Set CheckBoxes(n).ChkBoxGroup = obj.Object
        End If
    Next obj
End Sub

【讨论】：