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