You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA用户表单动态Checkbox选中/取消触发事件及同行控件隐藏问题

问题背景与需求

我有一个Userform,可从中选择活动列表(非强制选择)。每行设有4个Checkbox,分别代表妈妈、爸爸、父母、自己。需求为:选中某行的任意一个Checkbox后,隐藏该行内的其他Checkbox。

预期效果

参考ToggleButton和文本框的相关方案后仍未能解决问题。


初始化代码

Private Sub UserForm_Initialize()
Dim chkBox      As MSForms.Checkbox
Dim opt As Long 'Sheets
Dim i           As Long 'activities per sheet

For opt = 3 To Sheets.Count
    lastRow = Sheets(opt).Cells(Rows.Count, curColumn).End(xlUp).row
    For i = 1 To lastRow - 1
            Set chkBox = MultiPage1.Pages(opt - 3).Controls.Add("Forms.CheckBox.1", "CheckBox_" & opt & "_1_" & i) 'create activity and myself checkBox
        chkBox.Caption = Sheets(opt).Cells(i + 1, 1).Value 'A, C, C in my screenshot
       
         For c = 2 To 4 'create fields for Mum, Dad, Parents
        Set chkBox = MultiPage1.Pages(opt - 3).Controls.Add("Forms.CheckBox.1", "CheckBox_" & opt & "_" & c & "_" & i)
       Next c
  Next i
Next opt
End Sub

尝试过的代码

变量声明部分

Dim MyArray()   As Integer
'Dim cmdCBArray() As New clsRunTimeCheckBox
Private m_oCollectionOfEventHandlers As Collection

事件处理器集合初始化

Set m_oCollectionOfEventHandlers = New Collection

    Dim oControl As Control
    For Each oControl In Options.Controls
'        MsgBox oControl.Name
        If TypeName(oControl) = "CheckBox" Then
'            MsgBox oControl.TabIndex
            Dim oEventHandler As clsRunTimeCheckBox
            Set oEventHandler = New clsRunTimeCheckBox

'            Set oEventHandler.TextBox = oControl 'error: Method or Data member not found

            m_oCollectionOfEventHandlers.Add oEventHandler

        End If

    Next oControl

数组相关尝试

'        ReDim Preserve cmdCBArray(1 To MyArray(opt))
'            Set cmdCBArray(c + i).CmdCBEvents = chkBox 'gives error the third time
'            Set chkBox = Nothing

类模块中的代码尝试

第一段代码

'Public WithEvents CmdCBEvents As MSForms.Checkbox
'
'Private Sub CmdCBEvents_Change()
'    RaiseEvent Change
'End Sub
'
'Public Sub Change()
'    ' Respond to the checkbox change here
'    MsgBox "Checkbox changed!"
'End Sub

第二段代码

Private WithEvents m_oCBox As MSForms.Checkbox

Public Property Set CBox(ByVal oCBox As MSForms.Checkbox)
    Set m_oCBox = oCBox
End Property

Private Sub m_oCBox_Change()
    ' Do something
    MsgBox "Change enabled"
End Sub

说明:上述最后一段代码可正常打开UserForm,但勾选Checkbox时无消息框弹出,事件未触发。


核心问题

如何实现Checkbox状态变化的事件调用?

由于Checkbox有特定命名规则,可通过事件循环实现逻辑:

if CmDEvent is checked Then
   'read out opt, c and i from Name, e.g. = CB_opt_1_i; c = 1
   'set all other c to false
   Activities.Controls(CB_opt_2_i).Enabled = False
   Activities.Controls(CB_opt_3_i).Enabled = False
   Activities.Controls(CB_opt_4_i).Enabled = False

采纳建议后的更新代码

补充了MultiPage内的适配代码,现分享如下(clsCB代码保持不变):

Option Explicit

Dim colCB As Collection

Private Sub UserForm_Initialize()
    Dim cb As MSForms.CheckBox, r As Long, c As Long, S As Long, MultiPage1 As MSForms.MultiPage
    
    Set colCB = New Collection
    
    Set MultiPage1 = Me.Controls.Add("Forms.Multipage.1", "Test") 'creates 2 boxes
    With MultiPage1
        .Height = 150
    End With
    
    For S = 1 To 4
     If S > 2 Then
        MultiPage1.Pages.Add("Page" & S, "Page" & S)
    End If
    
    'Five rows of 4 checkboxes... "CheckBox_" & opt & "_1_" & i
    For r = 1 To 5
        For c = 1 To 4
            Set cb = MultiPage1.Pages(S - 1).Controls.Add("Forms.CheckBox.1", "CheckBox_" & S & "_" & c & "_" & r)
            cb.Top = -10 + 20 * r
            cb.Left = -10 + 20 * c
            colCB.Add GetHandler(cb) 'create the event handler object
        Next c
    Next r
    Next S
End Sub

'return a configured instance of clsCB
Function GetHandler(cb As MSForms.CheckBox) As clsCB
    Set GetHandler = New clsCB
    Set GetHandler.cb = cb
    Set GetHandler.frm = Me  'for the callback...
End Function

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
    Next cb2
End Sub

'Given a checkbox named "MP_S_Row_X_Col_Y" set `rw` to X and `col` to Y; "CheckBox_" & S & "_" & c & "_" & r
Sub ResolvePosition(cb As MSForms.CheckBox, ByRef rw As Long, ByRef col As Long, ByRef mp As Long)
    Dim arr
    arr = Split(cb.Name, "_")
    rw = arr(3)
    col = arr(2)
    mp = arr(1)
End Sub

内容的提问来源于Stack Exchange,提问作者Chris Peh

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.15 22:04:57