繁体   English   中英

集合WithEvents不适用于动态CheckBoxes和OptionButton-VBA Excel

[英]Collection WithEvents not working for dynamic CheckBoxes and OptionButtons - VBA excel

我正在研究一个查看工作表并在用户窗体上动态创建框架,标签(带有工作表中单元格的标题),复选框和两个选项按钮的项目。 根据工作表上有多少行来重复此过程。 有多个工作表,每个工作表都有一个与之相关的用户表单。 本质上,每个工作表形式的配对都执行相同的操作。 我希望能够为每个帧选择复选框或选项按钮之一。 如果选中此复选框,则应禁用选项按钮。 选项按钮在每个框架中均能正常工作,但除此之外,创建单元之后,与单元之间没有任何连接。 我试图合并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

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

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

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM