How to run the procedure after clicking on a combobox that was created dynamically

[aivin]

I have a userform with a sample combobox list like this:

Private Sub UserForm_Initialize()
Dim CooBox As MSForms.ComboBox, CooBoxPoz As String
Dim x As Integer

For x = 1 To 10
    CooBoxPoz = "CooBox" & x
    Set CooBox = UserForm1.Controls.Add("Forms.Combobox.1", CooBoxPoz, True)
    Call DynamicForms(CooBox, 90, 34 + ((x - 1) * 20), 126)
    UserForm1.Controls(CooBoxPoz).AddItem "Test1"
    UserForm1.Controls(CooBoxPoz).AddItem "Test2"
Next

End Sub

Sub DynamicForms(ByRef Element As MSForms.Control, ElLeft As Long, _
                 ElTop As Long, ElWidth As Long, Optional ElCaption As String)

'On Error Resume Next
If ElCaption <> "" Then
    Element.Caption = ElCaption
End If
Element.Left = ElLeft
Element.Top = ElTop
Element.Width = ElWidth

End Sub

Each CooBox1-10 comobox created has two items Test1 and Test2. I would like the procedure to be launched after clicking on any CooBox and changing from Test1 to Test2. The following example doesn't work. What am I doing wrong?

Private Sub CooBox3_Click()
MsgBox "3 click"
End Sub
Private Sub CooBox3_Change()
MsgBox "3 change"
End Sub

 

[Jaafar Tribak]

You could hook the dynamically added comboboxes using a Class Module or if you want to keep the entire code within the userform, you could use the following code :

Follow these steps:

1- Add the following code to the userform module
2- Export the userform module to some location on your drive
3- After you have verified that the userform module has been successfully excported as frm file, delete the userform module from your vbaproject.
4- Finally, import the exported userform back to your vbaproject:

Option Explicit

Private Type GUID
    Data1           As Long
    Data2           As Integer
    Data3           As Integer
    Data4(0& To 7&) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#Else
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If


Private Sub UserForm_Initialize()
    Dim CooBox As MSForms.ComboBox, CooBoxPoz As String
    Dim x As Integer
  
    For x = 1 To 10
        CooBoxPoz = "CooBox" & x
        Set CooBox = UserForm1.Controls.Add("Forms.Combobox.1", CooBoxPoz, True)
        Call DynamicForms(CooBox, 90, 34 + ((x - 1) * 20), 126)
        UserForm1.Controls(CooBoxPoz).AddItem "Test1"
        UserForm1.Controls(CooBoxPoz).AddItem "Test2"
    Next
End Sub

Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
    SetControlEvents(Control) = True
End Sub

Private Sub UserForm_Terminate()
    Dim oCtrl As Control
    For Each oCtrl In Me.Controls
        If oCtrl.Tag = "||" Then
            SetControlEvents(oCtrl) = False
        End If
    Next oCtrl
End Sub

Sub DynamicForms(ByRef Element As MSForms.Control, ElLeft As Long, _
                 ElTop As Long, ElWidth As Long, Optional ElCaption As String)
    'On Error Resume Next
    If ElCaption <> "" Then
        Element.Caption = ElCaption
    End If
    Element.Left = ElLeft
    Element.Top = ElTop
    Element.Width = ElWidth
End Sub

Private Property Let SetControlEvents(ByVal Combo As MSForms.ComboBox, ByVal SetEvents As Boolean)
    Const S_OK = &H0
    Dim tIID As GUID, lCookie As Long
  
    If IIDFromString(StrPtr("{00020400-0000-0000-C000-000000000046}"), tIID) = S_OK Then
        If ConnectToConnectionPoint(Me, tIID, SetEvents, Combo, lCookie) = S_OK Then
            If lCookie Then
                Combo.Tag = "||"
                'Debug.Print "Connection set for: " & Combo.Name
            Else
                'Debug.Print "Connection failed for: " & Combo.Name
            End If
        End If
    End If
End Property

Public Sub Change()
Attribute Change.VB_UserMemId = 2
    Attribute Change.VB_UserMemId = 2
    'Attribute Change.VB_UserMemId = 2
     MsgBox "You changed " & ActiveControl.Name
End Sub

Public Sub Click()
Attribute Click.VB_UserMemId = -610
    Attribute Click.VB_UserMemId = -610
    'Attribute Click.VB_UserMemId = -610
    MsgBox "You clicked " & ActiveControl.Name
End Sub

 

[aivin]

I did as you wrote - comboboxes still don't respond when changing/clicking

 

[Jaafar Tribak]

Oops! Sorry, I duplicated by mistake the Attribute Change.VB_UserMemId = 2 and Attribute Click.VB_UserMemId = -610

You can simply remove the 2 duplicates in red and it should work as expected.

Anyways, here is a file you can use for testing:
File Demo:
aivin.xlsm

Regards.

 

[aivin]

Yes - I saw these fields, but still nothing happens for me... Maybe it's a matter of the Excel version? I have v16

 

[Jaafar Tribak]

Yes - I saw these fields, but still nothing happens for me... Maybe it's a matter of the Excel version? I have v16

Have you tried the workbook in the link?

 

[Jaafar Tribak]

Ok. If you can't make that work, let's use the Class Module approach.

1- Add a new class module to your vbaproject and give the class module the name of CComboEvents
2- Place this code in the newly added class module:

Option Explicit

Public WithEvents Cmbbox As msforms.ComboBox

Private Sub Cmbbox_Change()
    MsgBox "You changed " & Cmbbox.Name
End Sub

Private Sub Cmbbox_Click()
    MsgBox "You clicked " & Cmbbox.Name
End Sub

3- Place this code in the UserForm Module:

Option Explicit

Private oCol As Collection

Private Sub UserForm_Initialize()
    Dim CooBox As msforms.ComboBox, CooBoxPoz As String
    Dim x As Integer
 
    For x = 1 To 10
        CooBoxPoz = "CooBox" & x
        Set CooBox = UserForm1.Controls.Add("Forms.Combobox.1", CooBoxPoz, True)
        Call DynamicForms(CooBox, 90, 34 + ((x - 1) * 20), 126)
        UserForm1.Controls(CooBoxPoz).AddItem "Test1"
        UserForm1.Controls(CooBoxPoz).AddItem "Test2"
    Next
End Sub

Private Sub UserForm_AddControl(ByVal Control As msforms.Control)
    Dim oClassEvents As CComboEvents
    If TypeOf Control Is msforms.ComboBox Then
        If oCol Is Nothing Then
            Set oCol = New Collection
        End If
        Set oClassEvents = New CComboEvents
        Set oClassEvents.Cmbbox = Control
        oCol.Add oClassEvents
    End If
End Sub

Sub DynamicForms(ByRef Element As msforms.Control, ElLeft As Long, _
                 ElTop As Long, ElWidth As Long, Optional ElCaption As String)
    'On Error Resume Next
    If ElCaption <> "" Then
        Element.Caption = ElCaption
    End If
    Element.Left = ElLeft
    Element.Top = ElTop
    Element.Width = ElWidth
End Sub

 

[aivin]

ok, after updating Office everything works, thanks!

 

[aivin]

I have one more question:
If I place comboboxes in the Frame, how can I modify UserForm_AddControl and CComboEvents so that the program responds only to clicks on the comboboxes that are in the frame?
Below is the combobox code in the frame

Private Sub UserForm_Initialize()
    Dim CooBox As msforms.ComboBox, CooBoxPoz As String
    Dim FreBox As msforms.Frame
    Dim x As Integer
    
    Set FreBox = UserForm1.Controls.Add("Forms.Frame.1", "Frame1", True)
    Call DynamicForms(FreBox, 12, 84, 366, "FRAME")
    For x = 1 To 10
        CooBoxPoz = "CooBox" & x
        Set CooBox = FreBox.Controls.Add("Forms.Combobox.1", CooBoxPoz, True)
        Call DynamicForms(CooBox, 90, 34 + ((x - 1) * 20), 126)
        UserForm1.Controls(CooBoxPoz).AddItem "Test1"
        UserForm1.Controls(CooBoxPoz).AddItem "Test2"
    Next
    FreBox.Height = 72 + ((x - 1) * 20)
    
End Sub

 

[Jaafar Tribak]

I have one more question:
If I place comboboxes in the Frame, how can I modify UserForm_AddControl and CComboEvents so that the program responds only to clicks on the comboboxes that are in the frame?

Leave the Class code as is and replace the previous UserForm code with this one:

Option Explicit

Private Sub UserForm_Initialize()
    Dim CooBox As msforms.ComboBox, CooBoxPoz As String
    Dim FreBox As msforms.Frame
    Dim x As Integer
    
    Set FreBox = UserForm1.Controls.Add("Forms.Frame.1", "Frame1", True)
    Call DynamicForms(FreBox, 12, 84, 366, "FRAME")
    For x = 1 To 10
        CooBoxPoz = "CooBox" & x
        Set CooBox = FreBox.Controls.Add("Forms.Combobox.1", CooBoxPoz, True)
        Call DynamicForms(CooBox, 90, 34 + ((x - 1) * 20), 126)
        Call HookCombo(CooBox)
        UserForm1.Controls(CooBoxPoz).AddItem "Test1"
        UserForm1.Controls(CooBoxPoz).AddItem "Test2"
    Next
    FreBox.Height = 72 + ((x - 1) * 20)
    
End Sub

Private Sub HookCombo(ByVal Combo As msforms.ComboBox)
        Static oCol As Collection
        Dim oClassEvents As CComboEvents
        If oCol Is Nothing Then
            Set oCol = New Collection
        End If
        Set oClassEvents = New CComboEvents
        Set oClassEvents.Cmbbox = Combo
        oCol.Add oClassEvents
End Sub

Sub DynamicForms(ByRef Element As msforms.Control, ElLeft As Long, _
                 ElTop As Long, ElWidth As Long, Optional ElCaption As String)
    'On Error Resume Next
    If ElCaption <> "" Then
        Element.Caption = ElCaption
    End If
    Element.Left = ElLeft
    Element.Top = ElTop
    Element.Width = ElWidth
End Sub