Creating a form on the fly..Label position not sticking

Kristin in CT

New Member
Joined
Sep 5, 2006
Messages
7
I have this code working fine when i run it with the debugger on or if i add a prompt after the creation of the label. I've tried a few different pieces of code and have see other code snippets that appear to do exactly what i'm doing but in some cases my TOP and left properties do not stick. Any ideas would be greatly appreciated. Here's a sample of what the code looks like...

for i = 1 to 24

Set NewLabel = TempForm.Designer.Controls.Add("forms.label.1")
extraLines = extraLines * 12

With NewLabel
.WordWrap = False
If extraLines > 0 Then .WordWrap = True
.Caption = i & ". " & SurveyQsht.Cells(2, i + 1)
.Height = 24 + extraLines
.Width = lblLen
.AutoSize = True
.Font.Name = "Verdana"
.Font.size = 10
.ForeColor = vbBlue
.Top = ctrlTopPos
.Left = 26
' MsgBox NewLabel.Top
End With
ctrlTopPos = ctrlTopPos +26
next i
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Hi Kristin, welcome to the Board!

Have you stepped through the code to check the value of ctrlTopPos?

In the sample you gave, it doesn't have an initial value.

Denis
 
Upvote 0
Hi Denis,
Thanks for welcome and reply!
I have the value initialized above the loop to 26.
If I step through the debugger it always works. Even if i throw up a prompt it works but if i run the code without the debugger the value of .top on the label is 0. One other thing i noticed, it's always the LAST object i add to the form.

Thanks again for any ideas.

Kristin
 
Upvote 0
That suggests something wacky with the loop.

Try adding this line just before Next i:

Debug.Print i & "; " & 26*i & "; " & ctrlTopPos

Run the code, then check in the Immediate window and see where it goes out of register. If I understand correctly, the 2 numbers on each Debug line should always be the same.

Denis
 
Upvote 0
Actually I did some more testing and i doesn't seem to be the last object i add just the last label. Although i know i've seen this behavior with other objects
 
Upvote 0
Kristin, I built a sample with labels only and it worked fine. See below --
Code:
Sub MakeForm()
    Dim TempForm As Object
    Dim NewLabel As MSForms.Label
    Dim i As Integer, ctrlTopPos As Integer
    Dim lblLen As Integer
    Dim ExtraLines As Integer
    
    ctrlTopPos = 15
    ExtraLines = 0
    lblLen = 125
    
    'create the userform
    Set TempForm = _
        ThisWorkbook.VBProject.VBComponents.Add(3)
    TempForm.Properties("width") = 180
    TempForm.Properties("height") = 15 * 28
    For i = 1 To 24
        Set NewLabel = TempForm.Designer.Controls.Add("forms.label.1")
        ExtraLines = ExtraLines * 12
        
        With NewLabel
        .WordWrap = False
        If ExtraLines > 0 Then .WordWrap = True
        .Caption = i & ". " & Sheets("SurveyQsht").Cells(2, i + 1)
        .Height = 13 + ExtraLines
        .Width = lblLen
        .AutoSize = True
        .Font.Name = "Verdana"
        .Font.Size = 10
        .ForeColor = vbBlue
        .Top = ctrlTopPos
        .Left = 26
        End With
        ctrlTopPos = ctrlTopPos + 15
    Next i
End Sub
I adjusted the spacing so the form would fit on my screen, but all labels lined up correctly. It looks like, if you are placing textboxes adjacent, there could be an issue with the code that lines up the labels and the textboxes.
If you can post some more detail, maybe we can track it down.

Denis
 
Upvote 0
Hi Denis,
that code works for me but mine still does not. I was trying to keep it simple but here's my code. I can think of an odd ball solution by adding one extra label and hiding it so don't feel obligated to answer. However if you're interested in the brain teaser...I'm interested in the real solution. Here's my full code:

Sub MakeForm()
Dim TempForm As Object, UserForm2 As Object 'VBComponent
Dim NewButton As MSForms.CommandButton
Dim NewLabel As MSForms.Label
Dim NewTextBox As MSForms.TextBox
Dim NewRadio As MSForms.OptionButton
Dim NewCombo As MSForms.ComboBox
Dim NewLstBox As MSForms.ListBox
Dim i As Integer, j As Integer, k As Integer, ctrlTopPos As Integer, lblLen As Integer, optwidth As Integer
Dim ExtraLines As Integer
Dim SurveyQsht As Worksheet
Dim NextLine As Double
Dim tName As String
Dim objCtl As Object

Set SurveyQsht = ActiveWorkbook.Sheets("DataSheet")

Application.VBE.MainWindow.Visible = False
For i = 1 To ThisWorkbook.VBProject.VBComponents.Count
If ThisWorkbook.VBProject.VBComponents(i).Name = "UserForm_Survey" Then
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(i)
End If
Next i
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3) 'vbext_ct_MSForm
With TempForm
.Properties("Caption") = "Survey Form"
.Properties("Width") = 600
.Properties("Height") = 400
.Properties("Scrollbars") = fmScrollBarsBoth
End With

ActiveWorkbook.Save
TempForm.Properties("Name") = "UserForm_Survey"

j = 1
'add questions
For i = 1 To SurveyQsht.Range("NumQuestions").Value
ctrlTopPos = ctrlTopPos + 26
If ctrlTopPos = 192 Then ctrlTopPos = 200
lblLen = SurveyQsht.Cells(15, i + 1).Value * 6
If lblLen > 500 Then lblLen = 372
optwidth = SurveyQsht.Cells(16, i + 1).Value
If SurveyQsht.Cells(16, i + 1).Value < 110 Then optwidth = 110

' Set objCtl = TempForm.Designer.Controls.Add("Forms.Label.1", "Lbl_" & i, True)

Set NewLabel = TempForm.Designer.Controls.Add("forms.label.1")
ExtraLines = SurveyQsht.Cells(17, i + 1) - 1
If ExtraLines <= 0 Then ExtraLines = 0
ExtraLines = ExtraLines * 12

With NewLabel
.WordWrap = False
If ExtraLines > 0 Then .WordWrap = True
.Caption = i & ". " & SurveyQsht.Cells(2, i + 1)
.Height = 24 + ExtraLines
.Width = lblLen
.AutoSize = True
.Font.Name = "Verdana"
.Font.size = 10
.ForeColor = vbBlue
.Top = ctrlTopPos '26 * i
.Left = 26
End With

ctrlTopPos = ctrlTopPos + 20 + ExtraLines
'new question
If SurveyQsht.Cells(5, i + 1).Value = "Select One" Then
Set NewCombo = TempForm.Designer.Controls.Add("forms.combobox.1")
With NewCombo
.Left = 36
.Top = ctrlTopPos
.Style = fmStyleDropDownList
.Width = optwidth
.Height = 18
.Name = "Q_" & i
tName = "Q_" & i
.Font.Name = "verdana"
.Font.size = 10
End With
ElseIf SurveyQsht.Cells(5, i + 1).Value = "Multi Choice" Then
Set NewLstBox = TempForm.Designer.Controls.Add("forms.ListBox.1")
With NewLstBox
.Top = ctrlTopPos
.Left = 36
.Height = 32
.Width = optwidth
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
.Name = "Q_" & i
tName = "Q_" & i
.Font.Name = "verdana"
.Font.size = 10

End With
ctrlTopPos = ctrlTopPos + 10 ' extra height for multi choice
ElseIf SurveyQsht.Cells(5, i + 1).Value = "Text" Then
Set NewTextBox = TempForm.Designer.Controls.Add("forms.TextBox.1")
With NewTextBox
.Name = "Q_" & i
tName = "Q_" & i
.AutoSize = False
.MultiLine = True
.Top = ctrlTopPos
.Left = 36
.Height = 36
.Width = 350
.Font.Name = "verdana"
.Font.size = 10
.ScrollBars = fmScrollBarsBoth
End With
ctrlTopPos = ctrlTopPos + 18 ' add padding for extra hieght in txt box
End If
Next i
' Add a CommandButton
Set NewButton = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewButton
.Name = "CmdSubmit"
.Caption = "Submit"
.Left = 26
.Top = ctrlTopPos + 26
End With

VBA.UserForms.Add(TempForm.Name).Show
 
Upvote 0
Hi Kristin,

I haven't run it yet but... does this range reflect the correct value?
Code:
For i = 1 To SurveyQsht.Range("NumQuestions").Value
Your loop depends on it

Denis
 
Upvote 0
To Answer your question yes.

....it occurs to me that perhaps font could have an role in this behavior. Have you ever entered a value in the height, width, top, left, ect
of a control or image and noticed that the program sometimes rounds it up or down. I'm curious if i'm entering a number that might want to be rounded but the program can't round because the form is not displayed in the VBE ; therefore it rejects the property value leaving it at 0.

It doesn't make sense to me. I just corrected a similar issue where height on a select box was getting reset when i updated other properties. I changed the order i was setting the properties in and the issue has been resolved. This doesn't seem to be the case for my last label though.
 
Upvote 0
RESOLVED - order of setting the properties apparently matters. Doesn't make a lick of sense to me, but it sure did fix the issue. I can swap the order and create the issue again too. Thanks for all your efforts!!!

With NewLabel
.WordWrap = False
If ExtraLines > 0 Then .WordWrap = True
.Top = ctrlTopPos
.Left = 26
.Caption = i & ". " & SurveyQsht.Cells(2, i + 1)
.Height = 24 + ExtraLines
.Width = lblLen
.AutoSize = True
.Font.Name = "Verdana"
.Font.size = 10
.ForeColor = vbBlue
'.Top = ctrlTopPos
'.Left = 26
'If i = SurveyQsht.Range("NumQuestions").Value Then MsgBox NewLabel.Top
'Application.StatusBar = .Top
' If i = SurveyQsht.Range("NumQuestions").Value Then MsgBox NewLabel.Top
End With
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,185
Members
448,554
Latest member
Gleisner2

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