Collection WithEvents 不适用于动态复选框和选项按钮 - VBA excel

Question

我正在研究一个查看工作表并在用户窗体上动态创建一个框架、一个标签（带有工作表上单元格的标题）、一个复选框和两个选项按钮的项目。这个过程是根据工作表上的多少行来迭代的。有多个工作表，每个工作表都有一个与之关联的用户表单。本质上，每个表单配对都做同样的事情。我希望能够为每个框架选择复选框或选项按钮之一。如果选中该复选框，则应禁用选项按钮。选项按钮在每个框架内都可以正常工作，但除此之外，在创建单元格后与单元格没有任何连接。我曾尝试合并 WithEvents 和 Collections，但无法弄清楚。现在我收到“对象不提供自动化事件”错误。我开始对框架的所有内部工作进行硬编码，所以我知道复选框和选项按钮工作的逻辑，但我真的希望能够动态创建这些。非常感谢任何见解。

这里是类（ClassOLF）：

Option Explicit

Public Collect As Collection

Private WithEvents cbox As MSForms.Checkbox
Private WithEvents optbtn1 As MSForms.OptionButton
Private WithEvents optbtn2 As MSForms.OptionButton

Public Property Set Checkbox(ByVal CHKbox As Checkbox)
    Set cbox = CHKbox
End Property

Private Sub cbox_Change()
            If NewChkBx.Value = True Then
                    NewOptBtn1.Enabled = False
                    NewOptBtn2.Enabled = False
                    NewOptBtn1.Value = False
                    NewOptBtn2.Value = False
                    Worksheets("SSRs").Cells(SRow, 3) = "N/A"
                    Worksheets("SSRs").Cells(SRow, 4) = ""
                    Worksheets("SSRs").Cells(SRow, 5) = ""
            End If

            If NewChkBx.Value = False Then
                    Worksheets("SSRs").Cells(SRow, 3) = ""
                    NewOptBtn1.Enabled = True
                    NewOptBtn2.Enabled = True
            End If
End Sub
Private Sub optbtn1_Click()
    Worksheets("ssrs").Cells(SRow, 4) = "Y"
    Worksheets("ssrs").Cells(SRow, 5) = ""
End Sub
Private Sub optbtn2_Click()
    Worksheets("ssrs").Cells(SRow, 4) = ""
    Worksheets("ssrs").Cells(SRow, 5) = "N"
End Sub

这是用户表单 ufSSR 的代码：

Private Collect As Collection

Private Sub UserForm_Initialize()

    Set Collect = New Collection

    Dim NewFrame As MSForms.Frame
    Dim NewLabel As MSForms.Label
    Dim NewOptBtn1 As MSForms.OptionButton
    Dim NewOptBtn2 As MSForms.OptionButton
    Dim NewChkBx As MSForms.Checkbox
    Dim labelCounter, Listarray As Integer
    Dim ClassMIF As ClassOLF

    Dim oControl As Control

    ' read how many rows are in SSR
    Listarray = ThisWorkbook.Sheets("SSRs").Range("SSRs").Rows.Count

    Top = 10        'sets Top

    Worksheets("SSRs").Range("SSR_selection").Clear

    For labelCounter = 1 To Listarray

            SRow = labelCounter + 1     'sets SSRs to proper row

            ' *** places Frames ***
            Set NewFrame = ufSSRs.Controls.Add("Forms.Frame.1")

            With NewFrame
                    .Height = 35
                    .Left = 10
                    .Width = 450
                    .Top = Top + 35 * labelCounter
            End With

            ' *** places SSRs into Labels ***
            Set NewLabel = NewFrame.Controls.Add("forms.label.1", "Test" &labelCounter, True)

            With NewLabel
                    .Caption = ThisWorkbook.Worksheets("ssrs").Cells(SRow, 2)
                    .TextAlign = fmTextAlignRight
                    .Font.Size = 16
'                        .Left
'                        .Top
                    .Width = 360
                    .Height = 30
'                        .BackStyle = fmBackStyleTransparent
                    .Visible = True
            End With

            ' *** places Check Box ***
            Set NewChkBx = NewFrame.Controls.Add("Forms.Checkbox.1", "chkbox" & SRow)
            Worksheets("SSRs").Cells(SRow, 3) = NewChkBx.Value
            cbxColl.Add (NewChkBx)
            Set ClassMIF = New ClassOLF
            Set ClassMIF.cbox = Me.Controls(NewChkBx.Name)
            Collect.Add ClassMIF
            With NewChkBx
                    .Left = 390
'                        .Top
                    .Width = 25
                    .Height = 30
                    .BackStyle = fmBackStyleTransparent
            End With

            ' *** places Option Button #1 ***
            Set NewOptBtn1 = NewFrame.Controls.Add("Forms.OptionButton.1", "optbtn1" & SRow)
            Worksheets("SSRs").Cells(SRow, 4) = NewOptBtn1.Value
            With NewOptBtn1
                    .Left = 410
'                        .Top
                    .Width = 25
                    .Height = 30
                    .BackStyle = fmBackStyleTransparent
                    Debug.Print SRow
            End With

            ' *** places Option Button #2 ***
            Set NewOptBtn2 = NewFrame.Controls.Add("Forms.OptionButton.1", "optbtn2" & SRow)
            Worksheets("SSRs").Cells(SRow, 5) = NewOptBtn2.Value
            With NewOptBtn2
                    .Left = 430
'                        .Top
                    .Width = 25
                    .Height = 30
                    .BackStyle = fmBackStyleTransparent
            End With

            SRow = SRow + 1
    Next

    For Each oControl In Me.Controls

                    If TypeName(oControl) = "chkbox" & SRow Then

                        Dim oEventHandler As ClassOLF
                        Set oEventHandler = New ClassOLF
                        Set oEventHandler.Checkbox = oControl
                        Collect.Add oEventHandler

                    End If

                    If TypeName(oControl) = "optbtn1" & SRow Then

                        Dim oEventHandler As ClassOLF
                        Set oEventHandler = New ClassOLF
                        Set oEventHandler.Checkbox = oControl
                        Collect.Add oEventHandler

                    End If

                    If TypeName(oControl) = "optbtn2" & SRow Then

                        Dim oEventHandler As ClassOLF
                        Set oEventHandler = New ClassOLF
                        Set oEventHandler.Checkbox = oControl
                        Collect.Add oEventHandler

                    End If

    Next oControl

End Sub

Answer 1

您实际上使用了错误的类。您需要将 MSForms 指定为库：

Private WithEvents cbox As MSForms.Checkbox
Private WithEvents optbtn1 As MSForms.OptionButton
Private WithEvents optbtn2 As MSForms.OptionButton

因为 Excel 库也有这些控件类型。