Building a UserForm Dynamically-Can't add code to button

Atroxell

Active Member
Joined
Apr 18, 2007
Messages
422
Hi all,

I am attempting to build my first dynamic userform. One problem I am having is probably pretty simple, I just don't know the answer. The second & third questions I will post separately as they are not a priority at this time.

Background:
I am designing a dynamic form so that the end user can establish a set of standard field names for use in standardizing a data processing regimen that they will use for multiple files. The intent is to allow the user to add or delete fields as desired, and have the form refresh/resize itself for a custom number of fields, with the ability to re-run it in the future should they need to. But first it populates with a group of recommended field values found in the dynamically named range called "stdFieldNames", which is column A in a sheet named "Headers" in this workbook.

And for simplicity at this time, I am using a pre-existing (empty) form that resides within the workbook. I am intending to later make the creation of the form itself part of the code--but that's a topic for another question.;)

So:
I have built the UserForm_Activate() procedure within the blank form to automatically build out the textboxes and buttons that will allow the user to modify the list of field names and IT WORKS!

That is, it works until I try to put code behind the first button when it is added to the form. I'm sure the problem is likely syntactical in nature, but I cannot find anything that will point me the right way. If I rem out the lines to write the code for the button, it works perfectly.

I get an error at "Line = .CountOfLines" (See below) The message is "Run-time error '438': Objects doesn't suppoprt this property or method"

Code:
Private Sub UserForm_Activate()
[COLOR=#ff0000]      ' Can this be modified to dynamically create the textboxes in the event that the user creates more (or less) fields?[/COLOR]
      Dim xControl As Control
      Dim c As Range
      Dim AppXCenter, AppYCenter As Long
      Dim ctlTXT As Control
      Dim ctlLabel As Control
      Dim commBtn1 As Msforms.CommandButton
      Dim commBtn2 As Msforms.CommandButton
    
[COLOR=#ff0000]      ' Define the top label position and contents.[/COLOR]
      Set ctlLabel = Me.Controls.Add("Forms.Label.1", "Label1", True)
      ctlLabel.Caption = "These will be your standard field names. Click 'OK' to accept them as they are, or replace with your preferred field names and click 'OK'."
      ctlLabel.Height = 138: ctlLabel.Width = 204: ctlLabel.Left = 6: ctlLabel.Top = 18: ctlLabel.Font.Size = 11: ctlLabel.TextAlign = fmTextAlignCenter: ctlLabel.Font.Name = "Callibri"
      
      With Me
            
[COLOR=#ff0000]            ' Build out the text boxes for however many rows are in the dynamic range 'stdFieldNames'[/COLOR]
[COLOR=#ff0000]            ' This will be the starting position for the first textbox:[/COLOR]
            topPos = 90
            For Each c In Sheets("Headers").Range("stdFieldNames")
            
                  Set ctlTXT = Controls.Add("Forms.TextBox.1", "Text" & c.Row - 1)
                  ctlTXT.Name = "TextBox" & c.Row - 1
                  If ctlTXT.Name = "TextBox1" Then               [COLOR=#ff0000] ' There's got to be a shorter algorithm for this than an IF statement...smh[/COLOR]
                        ctlTXT.Top = topPos
                  Else:
                        topPos = topPos + 18
                        ctlTXT.Top = topPos
                  End If
                  ctlTXT.Height = 15.6: ctlTXT.Width = 138: ctlTXT.Left = 36: ctlTXT.Value = c.Value
                                    
[COLOR=#ff0000]                  ' Exit loop when all existing field names have been read and text boxes created for existing field names.[/COLOR]
                  If c.Row = Sheets("Headers").Range("stdFieldNames").Rows.Count Then newFieldNo = c.Row + 1: Exit For
            Next c


[COLOR=#ff0000]            ' Button to accept changes is 24 points below last field.[/COLOR]
            Set commBtn1 = .Controls.Add("forms.CommandButton.1")
            With commBtn1
                  .Caption = "OK": .Height = 24: .Width = 78: .Left = 66: .Top = topPos + 24:
                  
[COLOR=#ff0000]                  '### This is where I am having the trouble###[/COLOR]
[COLOR=#ff0000]                  '### I get an error with "CountOfLines"###[/COLOR]
                  Line = .CountOfLines
                  .InsertLines Line + 1, "Sub CommandButton1_Click()"
                  .InsertLines Line + 2, "MsgBox ""Hello!"""
                  .InsertLines Line + 3, "End Sub"
            End With
      
      End With
      
      Set ctlTXT = Nothing          '[COLOR=#ff0000] Clear the textbox object[/COLOR]
      Set ctlLabel = Nothing        [COLOR=#ff0000]' Clear the label object

[/COLOR]
[COLOR=#ff0000]      ' Increment the top position of the next object.[/COLOR]
      topPos = topPos + 60
[COLOR=#ff0000]      ' Define the lower label position and contents[/COLOR]
      Set ctlLabel = Controls.Add("forms.label.1", "Label2")
      ctlLabel.Caption = "Or you can add as many fields as you like by entering the field name in the box below and clicking 'Submit'"
      ctlLabel.Height = 54: ctlLabel.Width = 204: ctlLabel.Left = 6: ctlLabel.Top = topPos: ctlLabel.Font.Size = 11: ctlLabel.TextAlign = fmTextAlignCenter: ctlLabel.Font.Name = "Callibri"
      
      topPos = topPos + 60
[COLOR=#ff0000]      ' Place the text field for adding new fields.[/COLOR]
      Set ctlTXT = Controls.Add("Forms.TextBox.1", "Text" & newFieldNo)
      ctlTXT.Name = "TextBox" & newFieldNo
      ctlTXT.Height = 15.6: ctlTXT.Width = 138: ctlTXT.Left = 36: ctlTXT.Top = topPos
      
      Set commBtn1 = Nothing              [COLOR=#ff0000]' Clear the commandbutton object[/COLOR]
      topPos = ctlTXT.Top + 24
[COLOR=#ff0000]      ' Button to accept changes is 24 points below last field.[/COLOR]
      Set commBtn1 = Me.Controls.Add("forms.CommandButton.1")
      With commBtn1
            .Caption = "OK": .Height = 24: .Width = 78: .Left = 72: .Top = topPos
      End With
            
[COLOR=#ff0000]      ' Set the final form position and size[/COLOR]
      AppXCenter = Application.Left + (Application.Width / 2)
      AppYCenter = Application.Top + (Application.Height / 2)
      With Me
            .ScrollBars = fmScrollBarsVertical                   
            .Height = 648
            .Width = 240
            .ScrollHeight = .InsideHeight * 1.2                 
            .ScrollWidth = .InsideWidth * 9                      
            .StartUpPosition = 0
            .Top = AppYCenter - (Me.Height / 2)
            .Left = AppXCenter - (Me.Width / 2)
      End With


End Sub

I am hoping someone out there has a better eye for what I am not seeing or a better brain for what I do not know.

TIA!
 
Last edited:

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
You should be adding the code to the userform module, not the controls themselves.

Mind you I'm not sure it's actually possible to do that at run time.

Are you creating everything, including the userform itself, using code?
 
Upvote 0
You should be adding the code to the userform module, not the controls themselves.

Mind you I'm not sure it's actually possible to do that at run time.

Are you creating everything, including the userform itself, using code?

Thanks for responding so quicklyQ

Generating the entire form from creation to completion without having a form reside in the "Forms" section of the project is what I will eventually want to do, yes. Right at this point I am just trying to get the form to populate with the proper objects and, hopefully, code in the buttons. Everything works except placing the code. Perhaps I can't do it in the UserForm_Activate().

Once I got it working at this level, I was planning to move the code to a module in the workbook to generate the form programmatically. I have not had any success generating a form from a standard module. That's why I am looking at it as "the next step." I guess I need to figure that out first. Any suggestions?
 
Upvote 0
You should be adding the code to the userform module, not the controls themselves.

Mind you I'm not sure it's actually possible to do that at run time.

Are you creating everything, including the userform itself, using code?

Ok, Norie. After reading your response the 45th time, I think I get what you are saying.

In order to create code programmatically in a userform, I can't be doing it inside the form.

So I have to:
1) Figure out how to generate a useform with code from a standard module,
2) place and modify all of this code inside that module, adjusted for correct object referencing,
3) then include the code for the button to the userform module. (NOT in the the UserForm_Activate() procedure.)

Is that right?
 
Upvote 0
Here's code that creates, and shows, a userform with 450 buttons.

It also adds some simple code behind each button that calls the sub ColorMacro.
Code:
Option Explicit
Public Const vbext_ct_MSForm = 3

Sub CreateFormAddButtons()
Dim objFrm As Object
Dim Btn As MSForms.CommandButton
Dim I As Long
Dim J As Long
Dim Line As Long
Dim lngTop As Long
Dim lngLeft As Long

    lngLeft = 2
    lngTop = 2

    Set objFrm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

    objFrm.Properties("Width").Value = 2

    For I = 1 To 450

        Set Btn = objFrm.Designer.Controls.Add("Forms.CommandButton.1")

        Randomize

        If Rnd > 0.5 Then
            Btn.BackColor = RGB(255, 255, 0)
        Else
            Btn.BackColor = RGB(0, 255, 0)
        End If

        Btn.Caption = I
        Btn.Font.Size = 6
        Btn.Height = 15
        Btn.Left = lngLeft
        Btn.Top = lngTop
        Btn.Width = 20

        lngLeft = Btn.Left + Btn.Width + 1

        If I < 15 Then
            objFrm.Properties("Width").Value = objFrm.Properties("Width").Value + Btn.Width
        End If

        With objFrm.CodeModule
            Line = .CountOfLines
            .InsertLines Line + 1, "Sub " & Btn.Name & "_Click()"
            .InsertLines Line + 2, "  Call ColorMacro(ActiveControl)"
            .InsertLines Line + 4, "End Sub"
        End With

        If I Mod 15 = 0 Then
            lngLeft = 2
            lngTop = lngTop + Btn.Height + 2

            objFrm.Properties("Height").Value = objFrm.Properties("Height").Value + Btn.Height
        End If
    Next I

    objFrm.Properties("Height") = lngTop + Btn.Height + 3

    ' show newly created form
    VBA.UserForms.Add(objFrm.Name).Show

End Sub

Sub ColorMacro(ByRef CmdBtn)
    Select Case CmdBtn.BackColor
        Case Is = RGB(255, 255, 0): MsgBox "Button is Yellow"
        Case Is = RGB(0, 255, 0): MsgBox "Button is Green"
        Case Else: MsgBox CmdBtn.Name & "-Unknown Color"
    End Select
End Sub

This code creates a userform with 11 textboxes.
Code:
Option Explicit

Sub CreateFormAddTBS()
Dim objFrm As Object
Dim Btn As MSForms.TextBox
Dim I As Long
Dim J As Long
Dim Line As Long
Dim lngTop As Long
Dim lngLeft As Long
Dim strName As String

    lngLeft = 2
    lngTop = 2

    strName = 228

    Set objFrm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

    For I = 1 To 11

        Set Btn = objFrm.Designer.Controls.Add("Forms.TextBox.1")

        Btn.Name = "TextBox" & strName
        Btn.Font.Size = 6
        Btn.Height = 15
        Btn.Left = lngLeft
        Btn.Top = lngTop
        Btn.Width = 72

        lngLeft = Btn.Left + Btn.Width + 1

        If I Mod 2 = 0 Then
            lngTop = lngTop + Btn.Height + 2
            lngLeft = 2
        End If

        strName = strName + 2

    Next I

    ' show newly created userform
    VBA.UserForms.Add(objFrm.Name).Show

End Sub

This code will delete all the userforms, which is handy when playing about with this sort of thing.:)
Code:
Sub DeleteAllForms()
Dim vbComp As Object

    For Each vbComp In ThisWorkbook.VBProject.VBComponents
        If vbComp.Type = vbext_ct_MSForm Then
            ThisWorkbook.VBProject.VBComponents.Remove vbComp
        End If
    Next vbComp

End Sub
 
Upvote 0
Here's code that creates, and shows, a userform with 450 buttons.

It also adds some simple code behind each button that calls the sub ColorMacro.
Code:
Option Explicit
Public Const vbext_ct_MSForm = 3

Sub CreateFormAddButtons()
Dim objFrm As Object
Dim Btn As MSForms.CommandButton
Dim I As Long
Dim J As Long
Dim Line As Long
Dim lngTop As Long
Dim lngLeft As Long

    lngLeft = 2
    lngTop = 2

    Set objFrm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

    objFrm.Properties("Width").Value = 2

    For I = 1 To 450

        Set Btn = objFrm.Designer.Controls.Add("Forms.CommandButton.1")

        Randomize

        If Rnd > 0.5 Then
            Btn.BackColor = RGB(255, 255, 0)
        Else
            Btn.BackColor = RGB(0, 255, 0)
        End If

        Btn.Caption = I
        Btn.Font.Size = 6
        Btn.Height = 15
        Btn.Left = lngLeft
        Btn.Top = lngTop
        Btn.Width = 20

        lngLeft = Btn.Left + Btn.Width + 1

        If I < 15 Then
            objFrm.Properties("Width").Value = objFrm.Properties("Width").Value + Btn.Width
        End If

        With objFrm.CodeModule
            Line = .CountOfLines
            .InsertLines Line + 1, "Sub " & Btn.Name & "_Click()"
            .InsertLines Line + 2, "  Call ColorMacro(ActiveControl)"
            .InsertLines Line + 4, "End Sub"
        End With

        If I Mod 15 = 0 Then
            lngLeft = 2
            lngTop = lngTop + Btn.Height + 2

            objFrm.Properties("Height").Value = objFrm.Properties("Height").Value + Btn.Height
        End If
    Next I

    objFrm.Properties("Height") = lngTop + Btn.Height + 3

    ' show newly created form
    VBA.UserForms.Add(objFrm.Name).Show

End Sub

Sub ColorMacro(ByRef CmdBtn)
    Select Case CmdBtn.BackColor
        Case Is = RGB(255, 255, 0): MsgBox "Button is Yellow"
        Case Is = RGB(0, 255, 0): MsgBox "Button is Green"
        Case Else: MsgBox CmdBtn.Name & "-Unknown Color"
    End Select
End Sub

This code creates a userform with 11 textboxes.
Code:
Option Explicit

Sub CreateFormAddTBS()
Dim objFrm As Object
Dim Btn As MSForms.TextBox
Dim I As Long
Dim J As Long
Dim Line As Long
Dim lngTop As Long
Dim lngLeft As Long
Dim strName As String

    lngLeft = 2
    lngTop = 2

    strName = 228

    Set objFrm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

    For I = 1 To 11

        Set Btn = objFrm.Designer.Controls.Add("Forms.TextBox.1")

        Btn.Name = "TextBox" & strName
        Btn.Font.Size = 6
        Btn.Height = 15
        Btn.Left = lngLeft
        Btn.Top = lngTop
        Btn.Width = 72

        lngLeft = Btn.Left + Btn.Width + 1

        If I Mod 2 = 0 Then
            lngTop = lngTop + Btn.Height + 2
            lngLeft = 2
        End If

        strName = strName + 2

    Next I

    ' show newly created userform
    VBA.UserForms.Add(objFrm.Name).Show

End Sub

This code will delete all the userforms, which is handy when playing about with this sort of thing.:)
Code:
Sub DeleteAllForms()
Dim vbComp As Object

    For Each vbComp In ThisWorkbook.VBProject.VBComponents
        If vbComp.Type = vbext_ct_MSForm Then
            ThisWorkbook.VBProject.VBComponents.Remove vbComp
        End If
    Next vbComp

End Sub

Wow! Thanks! I'll copy this off and play a bit with it. This is above and beyond what I was hoping for.

When I get it all settled, I'll post the final code for everyone.

(Sorry for the delay in responding. Went home for the evening. Back now.)
 
Upvote 0
Hi Norie, me again.

Cruising right along and making good progress. But I have onle line that's throwing an error I can't figure out. Here's the code: (Error location is in red)

Code:
Option Explicit
Public Const vbext_ct_MSForm = 3:                                       Dim c As Range
Dim topPos As Long:                                                                 Dim xControl As Control
Dim objFrm As Object:                                                              Dim clTXT As Control
Dim Btn As MSForms.CommandButton:                                Dim newFieldNo As Long
Dim txtBox As MSForms.TextBox:                                           Dim AppXCenter As Long
Dim ctlLabel As MSForms.Label:                                              Dim AppYCenter As Long
Dim I As Long:                                                                            Dim J As Long
Dim Line As Long


Sub CreateFieldSetupForm()
      
      Set objFrm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
      
      objFrm.Properties("Width").Value = 240
      
      ' Define the top label position and contents.
      Set ctlLabel = objFrm.Designer.Controls.Add("Forms.Label.1", "Label1", True)
      ctlLabel.Caption = "These will be your standard field names. Click 'OK' to accept them as they are, or replace with your preferred field names and click 'OK'."
      ctlLabel.Height = 138: ctlLabel.Width = 204: ctlLabel.Left = 6: ctlLabel.Top = 18: ctlLabel.Font.Size = 11: ctlLabel.TextAlign = fmTextAlignCenter: ctlLabel.Font.Name = "Callibri"
      
      Set ctlLabel = Nothing        ' Clear the label object
            
      With objFrm
            
            ' Build out the text boxes for however many rows are in the dynamic range 'stdFieldNames'
            ' This will be the starting position for the first textbox:
            topPos = 90
            For Each c In Sheets("Headers").Range("stdFieldNames")
            
                  Set txtBox = objFrm.Designer.Controls.Add("Forms.TextBox.1", "Text" & c.Row - 1)
                  txtBox.Name = "TextBox" & c.Row - 1
                  If txtBox.Name <> "TextBox1" Then topPos = topPos + 18 Else: topPos = 90
                  txtBox.Height = 15.6: txtBox.Width = 138: txtBox.Left = 36: txtBox.Value = c.Value: txtBox.Top = topPos
                                    
                  ' Exit loop when all existing field names have been read and text boxes created.
                  If c.Row = Sheets("Headers").Range("stdFieldNames").Rows.Count Then newFieldNo = c.Row + 1: Exit For
            Next c


            ' Button to accept changes is 24 points below last field.
            Set Btn = objFrm.Designer.Controls.Add("Forms.CommandButton.1")
            With Btn
                  .Caption = "OK": .Height = 24: .Width = 78: .Left = 66: .Top = topPos + 24:
            End With
            
            With objFrm.CodeModule
                  Line = .CountOfLines
                  .InsertLines Line + 1, "Sub " & Btn.Name & "_Click()"
                  .InsertLines Line + 2, "MsgBox ""Hello!"""
                  .InsertLines Line + 4, "End Sub"
            End With
      End With


      Set txtBox = Nothing          ' Clear the textbox object
      ' Increment the top position of the next object.
      topPos = Btn.Top + 45
      ' Define the lower label position and contents
      Set ctlLabel = objFrm.Designer.Controls.Add("forms.label.1", "Label2")
      ctlLabel.Caption = "Or you can add fields by entering the field name in the box below and clicking 'Add Field'"
      ctlLabel.Height = 54: ctlLabel.Width = 204: ctlLabel.Left = 6: ctlLabel.Top = topPos: ctlLabel.Font.Size = 11: ctlLabel.TextAlign = fmTextAlignCenter: ctlLabel.Font.Name = "Callibri"
      
      topPos = ctlLabel.Top + 60
      ' Place the text field for adding new fields.
      Set txtBox = objFrm.Designer.Controls.Add("Forms.TextBox.1", "Text" & newFieldNo)
      txtBox.Name = "TextBox" & newFieldNo
      txtBox.Height = 15.6: txtBox.Width = 138: txtBox.Left = 36: txtBox.Top = topPos
      
      ' Button to accept changes is 25 points below last field.
      topPos = txtBox.Top + 25
      Set Btn = objFrm.Designer.Controls.Add("Forms.CommandButton.1")
      With Btn
            .Caption = "Add Field": .Height = 24: .Width = 78: .Left = 66: .Top = topPos
      End With
      
      With objFrm.CodeModule
            Line = .CountOfLines
[B][COLOR=#ff0000]            .InsertLines Line + 1, "Sub " & Btn.Name & "_Click()"[/COLOR][/B]
            .InsertLines Line + 2, "MsgBox ""Hello!"""
            .InsertLines Line + 4, "End Sub"
      End With
      
      Set txtBox = Nothing             ' Clear the textbox object
      Set ctlLabel = Nothing           ' Clear the label object
      Set Btn = Nothing                  ' Clear the button object
      
      ' Set the final form position and size
      AppXCenter = Application.Left + (Application.Width / 2)
      AppYCenter = Application.Top + (Application.Height / 2)


      With objFrm
            .Properties.ScrollBars = fmScrollBarsVertical                    'This will create a vertical scrollbar
            .Properties("Height").Value = 648
            .Properties("Width").Value = 240
            .Properties.ScrollHeight = .InsideHeight * 1.2                   'Change the values as needed
            .Properties.ScrollWidth = .InsideWidth * 9                       ' Works fine
            .Properties.StartUpPosition = 0
            .Properties("Top").Value = AppYCenter - (.Properties("Height").Value / 2)
            .Propertied("Left").Value = AppXCenter - (.Properties("Width").Value / 2)
      End With
      
      ' show newly created form
      VBA.UserForms.Add(objFrm.Name).Show


End Sub

At the line of code in red I get a message saying "Can't enter break mode at this time." And gives me a set of buttons-"Continue", "End", "Debug" (greyed out) and "Help". If I click "End", only the line "Sub CommandButton1_Click() is written into the code module of the form and code exits.

If I click "Continue" I get "Object doesn't support this property or method". (Only "End" and "Help" are selectable at this point.) So I click "End" and the code finishes, completing all of the objects and code for the buttons.


EDIT: I had a break set just above the problem line of code. After removing the break, I only get the "Object doesn't support this property or method" message.

Other than some custom functions that I am not yet using, this is the only code in the workbook, so there's no other conflicts or interruptions for this code.
 
Last edited:
Upvote 0
How are you running the code?
 
Upvote 0
From a standard module using F5.

When I hit the problem I used F8 to step through it until I found the issue.
 
Upvote 0
I don't think the problem code is the section you've highlighted, I think the problem actually lies here.
Code:
With objFrm
            .Properties.ScrollBars = fmScrollBarsVertical                    'This will create a vertical scrollbar
            .Properties("Height").Value = 648
            .Properties("Width").Value = 240
            .Properties.ScrollHeight = .InsideHeight * 1.2                   'Change the values as needed
            .Properties.ScrollWidth = .InsideWidth * 9                       ' Works fine
            .Properties.StartUpPosition = 0
            .Properties("Top").Value = AppYCenter - (.Properties("Height").Value / 2)
            .Propertied("Left").Value = AppXCenter - (.Properties("Width").Value / 2)
      End With
You have to use Properties for each of the userform's properties including ScrollHeight, ScrollWidth etc.

This works for me.
Code:
Option Explicit
Public Const vbext_ct_MSForm = 3

Dim c As Range
Dim topPos As Long
Dim xControl As MSForms.Control
Dim objFrm As Object
Dim clTXT As MSForms.Control
Dim Btn As MSForms.CommandButton
Dim newFieldNo As Long
Dim txtBox As MSForms.TextBox
Dim ctlLabel As MSForms.Label
Dim AppXCenter As Long
Dim AppYCenter As Long
Dim I As Long
Dim J As Long
Dim Line As Long


Sub CreateFieldSetupForm()

    Set objFrm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

    objFrm.Properties("Width").Value = 240

    ' Define the top label position and contents.
    Set ctlLabel = objFrm.Designer.Controls.Add("Forms.Label.1", "Label1", True)
    ctlLabel.Caption = "These will be your standard field names. Click 'OK' to accept them as they are, or replace with your preferred field names and click 'OK'."
    ctlLabel.Height = 138: ctlLabel.Width = 204: ctlLabel.Left = 6: ctlLabel.Top = 18: ctlLabel.Font.Size = 11: ctlLabel.TextAlign = fmTextAlignCenter: ctlLabel.Font.Name = "Callibri"

    Set ctlLabel = Nothing        ' Clear the label object

    With objFrm

        ' Build out the text boxes for however many rows are in the dynamic range 'stdFieldNames'
        ' This will be the starting position for the first textbox:
        topPos = 90
        For Each c In Sheets("Headers").Range("stdFieldNames")

            Set txtBox = objFrm.Designer.Controls.Add("Forms.TextBox.1", "Text" & c.Row - 1)
            txtBox.Name = "TextBox" & c.Row - 1
            If txtBox.Name <> "TextBox1" Then topPos = topPos + 18 Else: topPos = 90
            txtBox.Height = 15.6: txtBox.Width = 138: txtBox.Left = 36: txtBox.Value = c.Value: txtBox.Top = topPos

            ' Exit loop when all existing field names have been read and text boxes created.
            If c.Row = Sheets("Headers").Range("stdFieldNames").Rows.Count Then newFieldNo = c.Row + 1: Exit For
        Next c


        ' Button to accept changes is 24 points below last field.
        Set Btn = objFrm.Designer.Controls.Add("Forms.CommandButton.1")
        With Btn
            .Caption = "OK": .Height = 24: .Width = 78: .Left = 66: .Top = topPos + 24:
        End With

        With objFrm.CodeModule
            Line = .CountOfLines
            .InsertLines Line + 1, "Sub " & Btn.Name & "_Click()"
            .InsertLines Line + 2, "MsgBox ""Hello!"""
            .InsertLines Line + 4, "End Sub"
        End With
    End With

    Set txtBox = Nothing          ' Clear the textbox object
    ' Increment the top position of the next object.
    topPos = Btn.Top + 45
    ' Define the lower label position and contents
    Set ctlLabel = objFrm.Designer.Controls.Add("forms.label.1", "Label2")
    ctlLabel.Caption = "Or you can add fields by entering the field name in the box below and clicking 'Add Field'"
    ctlLabel.Height = 54: ctlLabel.Width = 204: ctlLabel.Left = 6: ctlLabel.Top = topPos: ctlLabel.Font.Size = 11: ctlLabel.TextAlign = fmTextAlignCenter: ctlLabel.Font.Name = "Callibri"

    topPos = ctlLabel.Top + 60
    ' Place the text field for adding new fields.
    Set txtBox = objFrm.Designer.Controls.Add("Forms.TextBox.1", "Text" & newFieldNo)
    txtBox.Name = "TextBox" & newFieldNo
    txtBox.Height = 15.6: txtBox.Width = 138: txtBox.Left = 36: txtBox.Top = topPos

    ' Button to accept changes is 25 points below last field.
    topPos = txtBox.Top + 25
    
    Set Btn = objFrm.Designer.Controls.Add("Forms.CommandButton.1")
    
    With Btn
        .Caption = "Add Field": .Height = 24: .Width = 78: .Left = 66: .Top = topPos
    End With

    With objFrm.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub " & Btn.Name & "_Click()"
        .InsertLines Line + 2, "MsgBox ""Hello!"""
        .InsertLines Line + 4, "End Sub"
    End With

    Set txtBox = Nothing             ' Clear the textbox object
    Set ctlLabel = Nothing           ' Clear the label object
    Set Btn = Nothing                  ' Clear the button object

    ' Set the final form position and size
    AppXCenter = Application.Left + (Application.Width / 2)
    AppYCenter = Application.Top + (Application.Height / 2)

    With objFrm
        .Properties("ScrollBars") = fmScrollBarsVertical                    'This will create a vertical scrollbar
        .Properties("Height").Value = 648
        .Properties("Width").Value = 240
        .Properties("ScrollHeight") = .Properties("InsideHeight") * 1.2                   'Change the values as needed
        .Properties("ScrollWidth") = .Properties("InsideWidth") * 9                       ' Works fine
        .Properties("StartUpPosition") = 0
        .Properties("Top").Value = AppYCenter - (.Properties("Height").Value / 2)
        .Properties("Left").Value = AppXCenter - (.Properties("Width").Value / 2)
    End With

    ' show newly created form
    VBA.UserForms.Add(objFrm.Name).Show

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,266
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top