选中任何复选框时触发事件

Event trigger when any checkbox is checked

我有一份工作sheet,其中有一份等待从工厂发货的汽车零件清单。我需要在每个单元格中用复选框填充第 I 列。

我创建了一个名为“CREATE CHECKBOXES”的按钮,它查看存在多少行数据,然后使用从 CheckBox1 到 CheckboxN 的 ActiveX 复选框填充列 I 的每个单元格(n = 包含数据的行数)。那部分已经想通了。

接下来,当用户选中任何复选框时,它必须弹出一个带有 2 个数据字段输入的用户表单,这些输入将插入到已选中复选框同一行的 J 和 K 列中。我卡在代码中的地方是在选中任何复选框时触发用户窗体弹出的事件。

我看到了 ),但现在由于代码将复选框计为形状,我无法添加任何类型的按钮来向其添加宏。
我必须删除“CREATE CHECKBOXES”按钮,否则来自链接 post 的代码将无法工作。

如何在选中任何复选框并保持形状按钮时触发此用户窗体事件?

之后肯定会发生一些事情,但我想我可以处理。

我创建了一个名为 ChkClass 的 class 模块,代码如下:

' 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

然后将其粘贴到 sheet 代码中:

' this goes into sheet code
Private Sub Worksheet_Activate()
    activateCheckBoxes
End Sub

在那之后,我创建了一个模块,它是从链接 post:

稍微改编而来的
' this code goes into a module
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

如果 sheet 中没有其他按钮或形状,它会正确运行。如果我添加单个按钮或表单以向其添加宏,它不起作用。

如果您只想“激活”复选框,那么您可以遍历 sheet 的 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