Reputation:
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
Reputation: 42236
Please, try this adapted way:
Public frm As Object 'to use it even after the UserForm has been created
'to avoid it deletion when tested the code
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