CollectionEvent不适用于动态CheckBoxes和OptionButtons - VBA excel

时间:2015-02-19 04:52:21

标签: excel-vba collections 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

以下是userform ufSSRs的代码:

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

1 个答案:

答案 0 :(得分:1)

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

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

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