简体   繁体   中英

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

I am working on a project that looks at a worksheet and dynamically creates a frame on a userform, a label (with caption from a cell on the worksheet), a check box and two option buttons. This process is iterated based on however many rows are on the sheet. There are multiple sheets and each sheet has a userform associated to it. In essence, each sheet-form paring does the same thing. I want to be able to either select the check box or one of the option buttons for each frame. If the check box is selected, the option buttons should be disabled. The option buttons work properly within each frame but aside from that, there is not any connection to the cells after they are created. I have tried to incorporate WithEvents and Collections, but have not been able to figure it out. Now I get an "object does not source automation events" error. I started out hard coding all the inner-workings of the frames, so I know my logic for the check boxes and option buttons work, but I really want to be able to dynamically create these. Any insight is greatly appreciated.

Here is the class (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

Here is the code for 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

You're actually using the wrong classes. You need to specify MSForms as the library:

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

since the Excel library also has those control types.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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