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

[Atroxell]

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"

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!

 

[Atroxell]

Not quite sure how that block of code was throwing an error in the code writing section, but you are correct. This works perfectly.

Once again, your knowledge has given me solid and useful direction as I learn a little more VBA!

Thank you for sharing! Thank you, Thank you, Thank you!

Till the next time, have a great day!

I don't think the problem code is the section you've highlighted, I think the problem actually lies here.

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.

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