user15072454
user15072454

Reputation:

UserForm Object with Methods in VBA

I need to create an Object representing a UserForm, with methods to add Controls, and a method to present the UserForm.

I'm having a hard time wrapping my head around object-oriented VBA, and the tutorials/answers/documentation aren't helping me.

Here's how I imagine the Object and an example of its methods.

Sub UI_Window(caption as String)

    Dim Form As Object

    '   This is to stop screen flashing while creating form
    Application.VBE.MainWindow.Visible = False

    Set Form = ThisWorkbook.VBProject.VBComponents.Add(1)

    With Form
        .Properties("Caption") = caption
        .Properties("Width") = 600
        .Properties("Height") = 50
    End With

    return Form

    Sub addButton(action as String, code as String)
    
        Set NewButton = Form.designer.Controls.Add("Forms.commandbutton.1")
        With NewButton
            .Name = "cmd_1"
            .Caption = action
            .Accelerator = "M"
            .Top = Form.Height
            .Left = 50
            .Width = 500
            .Height = 100
            .Font.Size = 14
            .Font.Name = "Tahoma"
            .BackStyle = fmBackStyleOpaque
        End With

        '   Adjust height of Form to added content
        With Form
            .Properties("Height") = Form.Height + NewButton.Height + 50
        End With

        '   Should loop through code argument, line-by-line
        Form.codemodule.insertlines 8, "Private Sub cmd_1_Click()"
        Form.codemodule.insertlines 9, "msgbox (""Button clicked!"")"
        Form.codemodule.insertlines 10, "End Sub"
    
    End Sub

    Sub present()

        'Show the form
        VBA.UserForms.Add(Form.Name).Show
    
        'Delete the form
        ThisWorkbook.VBProject.VBComponents.Remove Form
    
    End Sub

End Sub

And here's how it would be used

Sub SampleWindow()

    Set Window = UI_Window "Window Title"
    Window.addButton "Click me", "msgbox (""Button clicked!"")"
    Window.present()

End Sub

Upvotes: 0

Views: 772

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Please, try this adapted way:

  1. Copy the next code on top of module where the following code exists:
   Public frm As Object 'to use it even after the UserForm has been created
                        'to avoid it deletion when tested the code
  1. Copy the next code in the same standard module:
Sub CreateAFormWithAButton()
 Const formName As String = "MyNewForm"
 Const formCaption As String = "My Form"
 
 removeForm formName 'remove the previously created form, if the case

 UI_Window formCaption, formName            'create the new form

 addButton frm, "myFirstButton", "Click Me" 'add a button
 VBA.UserForms.Add(frm.Name).Show           'show the newly created form
End Sub

Function formExists(frmName As String) As Boolean
   Dim fr As Variant
   For Each fr In ThisWorkbook.VBProject.VBComponents
       If fr.Type = vbext_ct_MSForm Then
            If frmName = fr.Name Then
                Set frm = fr
                formExists = True: Exit Function
            End If
       End If
   Next
End Function

Sub UI_Window(frmCaption As String, frmName As String)

    Set frm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm) '3

    With frm
        .Properties("Caption") = frmCaption
        .Properties("Width") = 500
        .Properties("Height") = 200
        .Properties("Name") = frmName
    End With
End Sub

Sub addButton(form As Object, btName As String, btCaption As String)
    Dim NewButton As MSForms.CommandButton
        If buttonExists(btName) Then MsgBox "A button named """ & btName & """ already exists...": Exit Sub 
        Set NewButton = form.Designer.Controls.Add("Forms.commandbutton.1")
        With NewButton
            .Name = btName
            .caption = btCaption
            .top = 0
            .left = 50
            .width = 100
            .height = 40
            .Font.size = 14
            .Font.Name = "Tahoma"
        End With

        '   Should loop through code argument, line-by-line
        form.CodeModule.InsertLines 8, "Private Sub " & btName & "_Click()"
        form.CodeModule.InsertLines 9, "     msgbox (""Button clicked!"")"
        form.CodeModule.InsertLines 10, "End Sub"
End Sub

Function buttonExists(btName As String) As Boolean
    Dim ctrl As Variant
    For Each ctrl In frm.Designer.Controls
        If ctrl.Name = btName Then buttonExists = True: Exit Function
    Next
End Function

Sub removeForm(frmName As String)
 Dim i As Long, strName As String
 If Not formExists(frmName) Then Exit Sub

 strName = "TestName"
tryAgain:
 On Error Resume Next
  frm.Name = strName
  If err.Number = 75 Then                 'a previously used name...
     err.Clear                            'clear the error
        strName = strName & i: i = i + 1  'increment the new string
        frm.Name = strName: GoTo tryAgain 'test the new name again
  End If
 On Error GoTo 0
 ThisWorkbook.VBProject.VBComponents.Remove frm
End Sub

If you will try running the code for the second time, you cannot create a button with the same name. The code check if the name exists and warn. It can be adapted to propose another name (adding an incremented number), but it needs also to set other positioning, making the code more complicated and this does not make the object of the question, I would say...

Please, run/test it and send some feedback.

Upvotes: 1

Related Questions