计算勾选复选框的数量

Question

按照此工作示例：VBA：选中/取消选中复选框时执行代码，我现在想计算每个选项有多少个勾选的复选框。 但是，我需要计数并显示“妈妈”计数和“爸爸”计数作为一个选择，“妈妈和爸爸”计数作为第二个计数。

我声明了 2 个附加变量：

Dim counter_MoD As Long
Dim counter_MaD As Long

我在用户表单中添加了 4 个标签：

'create labels for counter
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MoD")
        With txtBox
            .Caption = "Amount of selected ''Mum'' or ''Dad'': " '& counter_MoD
            .Left = 390
            .width = 150
            .Top = 3
            .Height = 9
        End With
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MoD_no")
        With txtBox
            .Caption = counter_MoD
            .TextAlign = 3
            .Left = 530
            .width = 10
            .Top = 3
            .Height = 9
        End With
        Sheets(1).Cells(14, 5).Value = counter_MoD
        
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MaD")
        With txtBox
            .Caption = "Amount of selected ''Mum & Dad'': " '& counter_MaD
            .Left = 390
            .width = 150
            .Top = 14
            .Height = 9
        End With
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MaD_no")
        With txtBox
            .Caption = counter_MaD
            .TextAlign = 3
            .Left = 530
            .width = 10
            .Top = 14
            .Height = 9
        End With
        Sheets(1).Cells(15, 5).Value = counter_MaD

我已将

HandleCheckboxClick

更改为：

Sub HandleCheckboxClick(cb As MSForms.CheckBox)
    Dim rw As Long, col As Long, mp As Long, rw2 As Long, col2 As Long, mp2 As Long, isOn As Boolean, cb2
    ResolvePosition cb, rw, col, mp
    
    isOn = (cb.Value)
    
    For Each cb2 In colCB  'check all of the event-handling objects
        ResolvePosition cb2.cb, rw2, col2, mp2
        'on same row, but not the checked box?
        If rw2 = rw And mp2 = mp And col2 <> col Then
            cb2.cb.Visible = IIf(isOn, False, True)
        End If
    'NEW CODE
'if "Mum" is selected, update counter
        If rw2 = rw And mp2 = mp And col = 1 And col2 = 1 Then
            counter_MoD = Sheets(1).Cells(14, 5).Value
            counter_MoD = IIf(isOn, counter_MoD + 1, counter_MoD - 1)
            '#1
'Options.Controls("Counter_MoD_no").Caption = counter_MoD 
            Sheets(1).Cells(14, 5).Value = counter_MoD
        End If
        'if "Dad" is selected, update (same) counter
        If rw2 = rw And mp2 = mp And col = 2 And col2 = 2 Then
            counter_MoD = Sheets(1).Cells(14, 5).Value
            counter_MoD = IIf(isOn, counter_MoD + 1, counter_MoD - 1)
'#2
'Options.Controls("Counter_MoD_no").Caption = counter_MoD
            Sheets(1).Cells(14, 5).Value = counter_MoD
        End If
        'if "Mum & Dad" is selected, update counter
        If rw2 = rw And mp2 = mp And col = 3 And col2 = 3 Then
            counter_MaD = Sheets(1).Cells(15, 5).Value
            counter_MaD = IIf(isOn, counter_MaD + 1, counter_MaD - 1)
                'update label
                    Options.Controls("Counter_MaD_no").Caption = counter_MaD
            Sheets(1).Cells(15, 5).Value = counter_MaD
        End If

    Next cb2
'#3
'Options.Controls("Counter_MoD_no").Caption = counter_MoD
End Sub

我可以显示 MaD 计数器并更新它。

但是，MoD 计数器可以增加（如：

Sheets(1).Cells(14, 5).Value

显示正确的刻度数），但是当我调用在用户窗体上的位置 #1、#2 或 #3 中显示时 - 都会给我相同的调试消息： “找不到指定的对象”；指向

frm.HandleCheckboxClick cb 'call code in the parent form

中的

clsCB

。 哪里需要插入代码以及如何修改？

Answer 1

是时候创建一个更有用的事件处理类了，它不是建模单个复选框，而是有 3 个复选框来代表复选框表中的一个“行”：

添加一个名为

clsCbRow

的新类模块：

Option Explicit

'just using public fields...
Public frm As UserForm1  '<< use the name of your form here...

Public WithEvents cbM As msforms.CheckBox    '<< the 3 checkboxes on a row
Public WithEvents cbD As msforms.CheckBox
Public WithEvents cbMaD As msforms.CheckBox

Private Sub cbM_Change()  '<< handle the click event for each checkbox
    HandleClick cbM
End Sub
Private Sub cbD_Change()
    HandleClick cbD
End Sub
Private Sub cbMaD_Change()
    HandleClick cbMaD
End Sub

'if `cb` is checked then uncheck the other checkboxes, and update counts
Private Sub HandleClick(cb As msforms.CheckBox)
    Dim isOn As Boolean, obj
    isOn = (cb.Value)
    If Not isOn Then Exit Sub
    For Each obj In Array(Me.cbM, Me.cbD, Me.cbMaD)
        If Not obj Is cb Then obj.Value = False 'uncheck other checkboxes
    Next obj
    frm.UpdateCounts '<<< call the form code to update the counts
End Sub

'couple of properties for counting "mum or dad" and "mum and dad"
Property Get MumOrDad() As Boolean
    MumOrDad = cbM.Value Or cbD.Value
End Property
Property Get MumAndDad() As Boolean
    MumAndDad = cbMaD.Value
End Property

这大大降低了主表单代码的复杂性。 一个非常基本的实现：

Option Explicit

Dim colCBRows As Collection 'collection of "row" objects

Private Sub UserForm_Initialize()
    Dim r As Long
    
    Set colCBRows = New Collection
    
    '10 rows of 3 checkboxes...
    For r = 1 To 10
        Dim cbM As msforms.CheckBox, cbD As msforms.CheckBox, cbMaD As msforms.CheckBox
        Set cbM = AddCheckbox("cbM" & r, "Mum", 20 * r, 20)
        Set cbD = AddCheckbox("cbD" & r, "Dad", 20 * r, 60)
        Set cbMaD = AddCheckbox("cbMaD" & r, "Mum+Dad", 20 * r, 100)
        colCBRows.Add GetHandler(cbM, cbD, cbMaD) 'create the "row" event handler object and add to `colCBRows`
    Next r
    
End Sub

'return a configured instance of clsCB
Function GetHandler(cbM As msforms.CheckBox, cbD As msforms.CheckBox, cbMaD As msforms.CheckBox) As clsCbRow
    Set GetHandler = New clsCbRow
    Set GetHandler.cbM = cbM
    Set GetHandler.cbD = cbD
    Set GetHandler.cbMaD = cbMaD
    Set GetHandler.frm = Me  'for the callback...
End Function

'utility function to add and configure a checkbox
Function AddCheckbox(cbName As String, cbCaption, cbTop As Long, cbLeft As Long) As msforms.CheckBox
    Dim cb As msforms.CheckBox
    Set cb = Me.Controls.Add("Forms.CheckBox.1", cbName)
    cb.Caption = cbCaption
    cb.Top = cbTop
    cb.Left = cbLeft
    Set AddCheckbox = cb
End Function

'called from clsCbRow whenever a checkbox is clicked
Sub UpdateCounts()
    Dim MorD As Long, MandD As Long, obj As clsCbRow
    For Each obj In colCBRows 'check each row of checkboxes
        If obj.MumOrDad Then MorD = MorD + 1
        If obj.MumAndDad Then MandD = MandD + 1
    Next obj
    'display counts
    Me.lblCounts.Caption = "Mum or dad = " & MorD & vbLf & "Mum and Dad = " & MandD
End Sub

运行形式示例：