excelvba

VBA generate a userform dynamically, bind an event to a button


I am trying to create a userform dynamically and assign it a button with a behavior, the generation of the userform and the button works but not the action when you click on the button... Here is my code (note that this is my first experience with classmodules and that I am not familiar with events):

Module named ConfPalletsLoader :

Sub CPL()
Dim fso As New FileSystemObject
Dim ConfigFile As Object
Dim ConfigLines As New Collection
Dim line As String
Dim key As String
Dim value As String

' Open the configuration file
Set ConfigFile = fso.OpenTextFile("C:\TDUFO\pallets.ini", 1)

Do Until ConfigFile.AtEndOfStream
    ConfigLines.Add ConfigFile.ReadLine
Loop
ConfigFile.Close

Dim configDict As Object
Dim inFormSection As Boolean
Dim currentForm As String
Dim i As Long
Dim formInstances As Collection
Set formInstances = New Collection ' To store instances of clsDynamicForm
Dim formInstance As clsDynamicForm

' Iterate over configuration lines
For i = 1 To ConfigLines.Count
    line = Trim(ConfigLines(i))
    
    ' Skip empty lines
    If line = "" Then GoTo ContinueLoop

    ' Detect start of a new form section
    If Left(line, 1) = "[" And Right(line, 1) = "]" Then
        ' If we're already processing a form, display it
        If Not configDict Is Nothing Then
            Set formInstance = New clsDynamicForm
            formInstance.CreateForm configDict
            formInstances.Add formInstance ' Store the instance
            formInstance.ShowForm
        End If
        
        ' Start a new form section
        Set configDict = CreateObject("Scripting.Dictionary")
        currentForm = Mid(line, 2, Len(line) - 2) ' Extract the form name
        inFormSection = True
    ElseIf inFormSection And InStr(line, "=") > 0 Then
        key = Trim(Split(line, "=")(0))
        value = Trim(Split(line, "=")(1))
        configDict.Add key, value
    End If
ContinueLoop:
Next i
' Ensure the last form is created after the loop ends
If Not configDict Is Nothing Then
    Set formInstance = New clsDynamicForm
    formInstance.CreateForm configDict
    formInstances.Add formInstance ' Store the instance
    formInstance.ShowForm
End If
End Sub

ClassModule named clsDynamicForm :

Option Explicit
Private buttonHandlers As Collection ' This should persist for the lifetime of the form
Private DynamicForm As Object ' Store the dynamically created form here

Public Sub CreateForm(configDict As Object)
    ' Load the template UserForm and store it in the DynamicForm variable
    Set DynamicForm = LoadFormInstance("TemplateUserForm")
    
    ' Initialize the button handler collection to keep handlers alive
    Set buttonHandlers = New Collection
    
    ' Set the UserForm properties using Object type
    With DynamicForm
        .Width = CLng(configDict("FormWidth"))
        .Height = CLng(configDict("FormHeight"))
        .Top = CLng(configDict("FormTop"))
        .Left = CLng(configDict("FormLeft"))

        ' Add buttons dynamically
        Dim buttonIndex As Long
        buttonIndex = 1
        
        Do While configDict.Exists("Button" & buttonIndex & "Caption")
            Dim btn As MSForms.CommandButton ' Ensure this is MSForms.CommandButton
            Set btn = .Controls.Add("Forms.CommandButton.1")
            
            ' Set button properties
            btn.Caption = configDict("Button" & buttonIndex & "Caption")
            btn.Top = CLng(configDict("Button" & buttonIndex & "Top"))
            btn.Left = CLng(configDict("Button" & buttonIndex & "Left"))
            btn.Width = CLng(configDict("Button" & buttonIndex & "Width"))
            btn.Height = CLng(configDict("Button" & buttonIndex & "Height"))
                
            ' Debugging: Check that the button is created
            Debug.Print "Button created: " & btn.Caption
            
            ' Create a new button handler for each button
            Dim btnHandler As clsButtonHandler
            Set btnHandler = New clsButtonHandler
            btnHandler.AssignButton btn
            
            ' Store the button handler in the collection to keep it in memory
            buttonHandlers.Add btnHandler
            
            ' Increment the button index to create the next button
            buttonIndex = buttonIndex + 1
        Loop
    End With
End Sub


' Show the form modelessly
Public Sub ShowForm()
    DynamicForm.Show vbModeless
End Sub


' Helper function to load a new instance of a UserForm by name
Private Function LoadFormInstance(formName As String) As Object
    Dim frm As Object
    Set frm = VBA.UserForms.Add(formName) ' Load a new instance of the template UserForm
    Set LoadFormInstance = frm ' Return the loaded UserForm instance
End Function

ClassModule named clsButtonHandler :

Option Explicit

' This class will handle the button click events
Private WithEvents Button As MSForms.CommandButton ' Ensure this is CommandButton

' Assign the button to the class
Public Sub AssignButton(ByVal btn As MSForms.CommandButton)
    Set Button = btn
    Debug.Print "Button assigned: " & btn.Caption ' Ensure the button is assigned
End Sub

' Handle the click event of the button
Private Sub Button_Click()
    MsgBox "Button clicked: " & Button.Caption, vbInformation
    Debug.Print "Button clicked: " & Button.Caption
    Call ButtonClickedSub
End Sub

A UserForm named TemplateUserForm, empty.

if you need to run my code, here is what pallets.ini contains (C:\TDUFO\pallets.ini):

[Form1]
FormWidth = 300
FormHeight = 200
FormTop = 100
FormLeft = 100
Button1Caption = "Button 1"
Button1Top = 30
Button1Left = 50
Button1Width = 80
Button1Height = 30

active references on the project:

Listing

Do you have any idea why the "Button Click" routine is not called?


Solution

  • The problem is that the formInstance is scoped to CPL(). When CPL() finishes the reference is broken.

    Dim formInstance As clsDynamicForm
    

    Making the formInstance variable Static will keep the variable reference alive but it would probably be better make it a module level variable.

    Static formInstance As clsDynamicForm