In my userform I ask the user how many listboxs they require and based on the number that the user enters the controls are dynamically created during run time. I want to be able to set the size of my userform based on the bottom position of the last dynamic control that was added to the userform. Below shows the code that I have written to do this, all I want to do at the minute is alert the bottom position of each dynamic control as they are added to the user form.
Dim dynamicControl As Control
For i = 1 To TextBox1.Value
Set cList = Me.Controls.Add("Forms.ListBox.1")
With cList
.Name = "listbox" & (i)
.Left = 150
.Top = listStartPosition
.Width = 300
.Height = 140
End With
Next i
dynamicControl = "listbox" & (i)
Msgbox dynamicControl.Bottom
When I run my code it errors out when I am trying to set the dynamicControl = "listbox" & 0 and the error I am recieving is object variable or with block variable not setobject variable or with block variable not set
to get your dynamic height you can use a code like this , by sending the number of clist this code is going to create them :
Private Sub createcontrol(num As Integer)
Dim StartPos As Integer
Dim WidthPos As Integer
StartPos = TextBox1.Top + TextBox1.Height + 10
For i = 1 To num
Set cList = Me.Controls.Add("Forms.ListBox.1")
With cList
.Name = "listbox" & (i)
.Left = 150
.Top = StartPos
.Width = 300
.Height = 140
StartPos = StartPos + .Height + 10
Me.Width = .Width + .Left
End With
Next i
Me.Height = StartPos - 8
End Sub
Related
What would the reason be for a VBA user form with an EventHandler class to throw a Run-time error '9': Subscript out of range
BUT
If I F8 and step into the UserForm code I can step right through the entire code without it crashing
Just for simplicity here is my event handler class LabelEventHandler
Private WithEvents Innerlabel As MSForms.Label
Private InnerRow As Integer
Private InnerSheet As Worksheet
Public Property Set Label(ByVal InLabel As MSForms.Label)
Set Innerlabel = InLabel
End Property
Public Property Let Row(ByVal InRow As Integer)
InnerRow = InRow
End Property
Public Property Set Sheet(ByVal InSheet As Worksheet)
Set InnerSheet = InSheet
End Property
Private Sub InnerLabel_Click()
Dim Frame As MSForms.Frame
Dim ChildLabel As MSForms.Label
Set Frame = Innerlabel.Parent
For Each ChildLabel In Frame.Controls
Select Case ChildLabel.Name
Case "FullName"
InnerSheet.Cells(InnerRow, 4).Value = ChildLabel.Caption
Case "Email"
InnerSheet.Cells(InnerRow, 5).Value = ChildLabel.Caption
Case "Phone"
InnerSheet.Cells(InnerRow, 6).Value = ChildLabel.Caption
End Select
Next
End Sub
and here is the UserForm code
Private Sheet As Worksheet
Private LabelClickArray() As New LabelEventHandler
Public Sub AddUser(FullName As String, Email As String, Phone As String)
Dim FullNameLabel As MSForms.Label
Dim EmailLabel As MSForms.Label
Dim PhoneLabel As MSForms.Label
Dim UserFrame As Frame
Dim Top
Top = FindBottomUserRow()
Set UserFrame = Me.Controls.Add("Forms.Frame.1")
With UserFrame
.Top = Top
.Left = 5
.Width = 660
.Height = 20
.Font.Name = "Verdana"
.Font.Size = 12
.Font.Weight = 400
.Caption = ""
.BorderStyle = fmBorderStyleNone
End With
Set FullNameLabel = UserFrame.Controls.Add("Forms.Label.1")
Set EmailLabel = UserFrame.Controls.Add("Forms.Label.1")
Set PhoneLabel = UserFrame.Controls.Add("Forms.Label.1")
With FullNameLabel
.Top = 0
.Left = 0
.Width = 200
.Height = 15
.Name = "FullName"
.Caption = FullName
End With
With EmailLabel
.Top = 0
.Left = 205
.Width = 300
.Height = 15
.Name = "Email"
.Caption = Email
End With
With PhoneLabel
.Top = 0
.Left = 510
.Width = 150
.Height = 15
.Name = "Phone"
.Caption = Phone
End With
ReDim Preserve LabelClickArray(UBound(LabelClickArray) + 3)
Set LabelClickArray(UBound(LabelClickArray) - 2).Label = FullNameLabel
Set LabelClickArray(UBound(LabelClickArray) - 1).Label = EmailLabel
Set LabelClickArray(UBound(LabelClickArray)).Label = PhoneLabel
Set LabelClickArray(UBound(LabelClickArray) - 2).Sheet = Sheet
Set LabelClickArray(UBound(LabelClickArray) - 1).Sheet = Sheet
Set LabelClickArray(UBound(LabelClickArray)).Sheet = Sheet
LabelClickArray(UBound(LabelClickArray) - 2).Row = ActiveCell.Row
LabelClickArray(UBound(LabelClickArray) - 1).Row = ActiveCell.Row
LabelClickArray(UBound(LabelClickArray)).Row = ActiveCell.Row
End Sub
Function FindBottomUserRow()
Dim Frame As Control
Dim Top
Top = 30
For Each Frame In Me.Controls
If (TypeName(Frame) = "Frame" And Frame.Top > Top) Then Top = Frame.Top
Next
If (Top > 30) Then Top = Top + 20
FindBottomUserRow = Top
End Function
Private Sub UserForm_Initialize()
Set Sheet = ActiveSheet
Me.AddUser "Ryan", "ryan#r.com", "2625"
Me.AddUser "Jeff", "j#k.com", "123-4567"
End Sub
The error
Your error happens at the ReDim Preserve command, because you never initialized the array. You cannot execute a UBound-function to a non-initialized array (if you try, you get the Runtime error 9). If you cannot be sure at runtime if your array in already initialized, change your code to:
If IsArrayAllocated(LabelClickArray) Then
ReDim Preserve LabelClickArray(UBound(LabelClickArray) + 3)
Else
ReDim LabelClickArray(3)
End If
The function IsArrayAllocated looks like this:
Function IsArrayAllocated(arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = IsArray(arr) _
And Not IsError(LBound(arr, 1)) _
And LBound(arr, 1) <= UBound(arr, 1)
End Function
(Code copied from cpearson)
I have this code and it dynamically creates text boxes and labels based on the user input for text box number. But I am getting
424 error
I tried to debug using F8.
I will have a column(dynamically updated) using which the labels have to be created and the count of the column items are the number of textboxes (will replace the input box with count of the column.)
Dim number As Long
Private Sub UserForm_Initialize()
Dim i As Long
number = InputBox("enter the number")
Dim txtB1 As Control
For i = 1 To number
Set txtB1 = Controls.Add(“Forms.TextBox1”)
With txtB1
.Name = “txtBox” & i
.Height = 20
.Width = 50
.Left = 70
.Top = 20 * i * 1
End With
Next i
Dim lblL1 As Control
For i = 1 To number
Set lblL1 = Controls.Add(“Forms.Label1”)
With lblL1
.Caption = “Label” & i
.Name = “lbl” & i
.Height = 20
.Width = 50
.Left = 20
.Top = 20 * i * 1
End With
Next i
Dim q As Long
For q = 1 To number
Controls(“lbl” & q) = Cells(1, q)
Next q
End Sub
Private Sub CommandButton1_Click()
Dim p As Long
Dim erow As Long
erow = "Sheet3!A2:A" & Range("A" & Rows.Count).End(xlUp).Row
For p = 1 To number
Cells(erow, p) = Controls(“txtBox” & p).Text
Next p
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
424 error is showing problem with this line
Set txtB1 = Controls.Add(“Forms.TextBox1”)
Thanks in advance
As mentioned already, the correct string to create a textbox on the fly is this:
Forms.TextBox.1
Notice the additional period .. See here for reference.
Set txtB1 = Controls.Add("Forms.TextBox.1")
To wrap up the other points made in the comments too:
You can add an explicit Me to make it even more clear where the controls live, i.e. Me.Controls(...). But excluding it will always implicitly link to the correct userform.
Just be careful that you use " rather than “
I have created a Userform that will dynamically create ComboBoxes based on a number that the user enters on a previous page (numofSku). I populated the contents of the first set of ComboBoxes (skubox) from an Access database, and I'd like to populate the second set (asst) based on the values of the first set. Naturally, you'd use something like ComboBox1_Change() but I'm not sure how to do this with a dynamic set of ComboBoxes.
Code that I use to create the comboboxes:
Dim cCntrl As Control
Dim eCntrl As Control
Dim fCntrl As Control
Dim gCntrl As Control
Dim hCntrl As Control
Dim iCntrl As Control
For d = 1 To numofSku
Set cCntrl = Controls.Add("Forms.ComboBox.1", "", True)
Set eCntrl = Controls.Add("Forms.Label.1", "", True)
Set fCntrl = Controls.Add("Forms.ComboBox.1", "", True)
Set gCntrl = Controls.Add("Forms.Label.1", "", True)
Set hCntrl = Controls.Add("Forms.TextBox.1", "", True)
Set iCntrl = Controls.Add("Forms.Label.1", "", True)
With cCntrl
.Name = "skubox" & d
.Width = 90
.Height = 18
.top = 5 + (d * 25)
.Left = 60
End With
With eCntrl
.Caption = "SKU " & d & ":"
.Width = 35
.Height = 25
.top = 5 + (d * 25)
.Left = 25
End With
With fCntrl
.Name = "asst" & d
.Width = 45
.Height = 18
.top = 5 + (d * 25)
.Left = 190
End With
With gCntrl
.Caption = "ASST: "
.Width = 30
.Height = 25
.top = 5 + (d * 25)
.Left = 160
End With
With hCntrl
.Name = "qty" & d
.Width = 45
.Height = 18
.top = 5 + (d * 25)
.Left = 280
End With
With iCntrl
.Caption = "QTY: "
.Width = 30
.Height = 25
.top = 5 + (d * 25)
.Left = 250
End With
Next d
Code that I use to fill the first set of comboboxes:
For e = 1 To numofSku
rst.Open "SELECT MasterSKU FROM Brand WHERE Brand = " & "'" & getBrand & "'"
rst.MoveFirst
With Me.Controls("skubox" & e)
.Clear
Do
.AddItem rst![MasterSKU]
rst.MoveNext
Loop Until rst.EOF
End With
rst.Close
Next e
The short answer is: "you cannot create controls dynamically at runtime in Access!".
You can do it in design view. This is helpful for wizards.
The long answer: My approach to this problem is to put a lot of controls on the form in advance and to set their Visible property to False. Then, at runtime, you can dynamically make the controls you need visible.
Also, consider using a sub-form. In Access, you can insert a Form into another Form as if it was a Control. In fact, Access inserts a Subform-Control displaying the form.
Display this subform either as Datasheet or as Continuous Forms by setting its Default View property accordingly. The Datasheet view looks like a table, whereas the Continuous Forms view displays one copy of the subform per data record.
I have tried #DaveShaw code, for events on runtime for checkboxes, is click not an valid method for checkbox? It never get into the method checkBoxEvent_click
Dim CheckBoxArray() As New ClassEvents
for i=0 to 10
Set cTemp = MOM.Frame_MOM_MOM.Controls.Add("Forms.CheckBox.1")
With cTemp
.Top = HeaderOffset + RowOffset + i * 25 'your top pos
.Visible = True
.Left = 30 'your left pos
.Width = widthOfLabel 'your width
.Name = Replace(keyArrays(i, 1), " ", "_")
.Caption = keyArrays(i, 1) 'your caption ,
End With
ReDim Preserve CheckBoxArray(0 To i)
Set CheckBoxArray(i).checkBoxEvent = cTemp
next i
and my ClassEvents class looks like this:
Public WithEvents checkBoxEvent As MSForms.checkBox
Private Sub checkBoxEvent_click()
MsgBox "halla" 'checkBox.Caption
End Sub
you have to keep Dim CheckBoxArray() As New ClassEvents at the very top of your userfom code pane, thus outside any of its subs/functions
furthermore use Option Explicit statement too
it becomes
Option Explicit
Dim CheckBoxArray() As New ClassEvents '<--| keep this line at the very top of your userform code pane
Private Sub UserForm_Initialize()
Dim i As Long
Dim cTemp As MSForms.CheckBox '<-- with "Option Explicit" you have to declare all your variables
For i = 0 To 10
Set cTemp = MOM.Frame_MOM_MOM.Controls.Add("Forms.CheckBox.1")
With cTemp
.Top = HeaderOffset + RowOffset + i * 25 'your top pos
.Visible = True
.Left = 30 'your left pos
.Width = widthOfLabel 'your width
.Name = Replace(keyArrays(i, 1), " ", "_")
.Caption = keyArrays(i, 1) 'your caption ,
End With
ReDim Preserve CheckBoxArray(0 To i)
Set CheckBoxArray(i).checkBoxEvent = cTemp
Next i
End Sub
furthermore, since you already know the dimension of your array, Dim it at the beginning and don't ReDim it at every iteration:
Option Explicit
Dim CheckBoxArray(0 To 10) As New ClassEvents '<--| keep this line at the very top of your userform code pane
Private Sub UserForm_Initialize()
Dim i As Long
Dim cTemp As MSForms.CheckBox '<-- with "Option Explicit" you have to declare all your variables
For i = 0 To 10
Set cTemp = MOM.Frame_MOM_MOM.Controls.Add("Forms.CheckBox.1")
With cTemp
.Top = HeaderOffset + RowOffset + i * 25 'your top pos
.Visible = True
.Left = 30 'your left pos
.Width = widthOfLabel 'your width
.Name = Replace(keyArrays(i, 1), " ", "_")
.Caption = keyArrays(i, 1) 'your caption ,
End With
Set CheckBoxArray(i).checkBoxEvent = cTemp
Next i
End Sub
I’d be glad to get some help! I’ve been searching the whole net but I’m stuck!
I’ve been programming VBA for a while but I’m still struggling to understand this language!
I want to create a VBA UserForm in MS Project 2007 VBA.
A few data are dynamic and so I need to add a few text fields during runtime.
I put some code together to add these and it works quite fine.
My problem is to add events to these text fields.
My example is the txtPath text field.
I create it with this code:
Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1")
With NewTextBox
.name = "txtPath"
.value = "Test"
.top = m2w_style("top") + (m2w_style("height") * 1)
.Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin")
.Width = m2w_style("txtWidth")
.height = m2w_style("height")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
End With
And I want a reaction if the value of txtPath has changed.
Here the code:
Private Sub txtPath_Change() ' Event doesn't shoot
readProjectsFromConfig (Me.value)
End Sub
All websites I’ve browsed and searched show that it should work this way, but the event just doesn’t shoot.
I found out that the dynamic created text field are not displayed at the same place in the tree of the “local window” like the manually created text boxes.
So I tried this to at least get the value of the text field and it works.
Private Sub btnPath_Click()
'txtPath.value = "Hello World!" ' Doesn't work. Dynamicly created text field seems not to exist but is visible in UserForm
'Controls.Item("txtPath").value = "Hello World!" ' This works!
Controls.Item("txtPath").value = GetDirectory("Pick the folder") ' Pick a folder and write it in the text field txtPath
End Sub
Here’s the full code for testing:
' Reference to Library
' Microsoft XML, v5.0 need to be activated.
' Go to menu: Tools->References
' Select Microsoft Scripting Runtime
Public m2w_config As Dictionary
Public m2w_style As Dictionary
Sub m2wVariables()
' Set global Variables for configuration in a kind of hash.
Set m2w_config = New Dictionary
Set m2w_style = New Dictionary
'Styles for teh UserForm
m2w_style("font") = "Arial"
m2w_style("fontsize") = 10
m2w_style("top") = 6
m2w_style("left") = 6
m2w_style("height") = 20
m2w_style("btnHeight") = 8
m2w_style("width") = 40
m2w_style("lblWidth") = 40
m2w_style("h1Width") = 400
m2w_style("txtWidth") = 180
m2w_style("btnWidth") = 72
m2w_style("margin") = 6
m2w_config("XMLDateFormat") = "YYYY-MM-DD"
m2w_config("XMLConfigFileName") = "config.xml" ' should not be changeable
m2w_config("AppPath") = ""
m2w_config("Headline") = "" ' Headline in Website
m2w_config("UpdateHref") = ""
m2w_config("SubFolder") = "" ' Is it used?
m2w_config("default_subfolder") = "" ' Is it used?
End Sub
Private Sub UserForm_Activate()
Dim LabelArr As Variant
Dim ProbNameArr As Variant
Dim TempForm As Object
Dim NewButton As MSForms.CommandButton
Dim NewLabel As MSForms.Label
Dim NewTextBox As MSForms.TextBox
Dim e As Variant
Dim x As Integer
Dim page As String
'Dim Line As Integer
'Dim MyScript(4) As String
m2wVariables
' Setup userform
'~~~~~~~~~~~~~~~~
'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False
' Setup tab Website
'===================
page = "Website"
Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1")
With NewLabel
.name = "lblHeadlinePath"
.Caption = "This is the local path where the website shall be stored."
.top = m2w_style("top") + (m2w_style("height") * 0)
.Left = m2w_style("left")
.Width = m2w_style("h1Width")
.height = m2w_style("height")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
End With
Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1")
With NewLabel
.name = "lblPath"
.Caption = "Path:"
.top = m2w_style("top") + (m2w_style("height") * 1)
.Left = m2w_style("left")
.Width = m2w_style("lblWidth")
.height = m2w_style("height")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
End With
Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1")
With NewTextBox
.name = "txtPath"
.value = "Test"
.top = m2w_style("top") + (m2w_style("height") * 1)
.Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin")
.Width = m2w_style("txtWidth")
.height = m2w_style("height")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
End With
'Add event onClick
' This is completely weird, it actualy writes code.
' My intention is to add an event at runtime.
With ThisProject.VBProject.VBComponents("msp2web_SettingsForm").CodeModule
.insertlines .CountOfLines + 1, "Sub txtPath_Change()" & vbCrLf & "MsgBox Me.txtPath.Value" & vbCrLf & "End Sub"
Debug.Print Now & " This macro has code lines " & .CountOfLines
End With
Dim btnName As String
btnName = "btnPath"
'Set NewButton = Me.InfoMultiPage(page).Controls.Add("Forms.commandbutton.1", btnName) ' Add dynamicly - but I'm too stupid to add an event action to an dynamicly created button...
Set NewButton = Me.InfoMultiPage(page).Controls.Item(btnName)
With NewButton
.Caption = "Browse..."
.top = m2w_style("top") + (m2w_style("height") * 1)
.Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin") + m2w_style("txtWidth") + m2w_style("margin")
.Width = m2w_style("lblWidth")
.height = m2w_style("btnHeight")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
.AutoSize = True
End With
' Setup Tab Project
'===================
page = "Project"
LabelArr = Array("Hallo", "Welt", "Model Year")
ProbNameArr = Array("Hallo", "Welt", "Model Year")
'Create 10 Labels just for testing - works fine
'For x = 0 To 9
x = 0
For Each e In LabelArr
Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1")
With NewLabel
.name = "FieldLabel" & x + 1
.Caption = e
.top = m2w_style("top") + (m2w_style("height") * x)
.Left = m2w_style("left")
.Width = m2w_style("lblWidth")
.height = m2w_style("height")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
End With
x = x + 1
Next
'Create 10 Text Boxes
'For x = 0 To 9
x = 0
For Each e In ProbNameArr
Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1")
With NewTextBox
.name = "MyTextBox" & x + 1
.top = m2w_style("top") + (m2w_style("height") * x)
.Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin")
.Width = m2w_style("lblWidth")
.height = m2w_style("height")
.font.Size = m2w_style("fontsize")
.font.name = m2w_style("font")
End With
x = x + 1
Next
End Sub
Private Sub btnPath_Click()
'txtPath.value = "Hello World!" ' Doesn't work. Dynamicly created text field seems not to exist but is visible in UserForm
'Controls.Item("txtPath").value = "Hello World!" ' This works!
Controls.Item("txtPath").value = GetDirectory("Pick the folder") ' Pick a folder and write it in the text field txtPath
End Sub
Private Sub txtPath_Change() ' Event doesn't shoot
readProjectsFromConfig (Me.value)
End Sub
Private Sub Refresh_Click()
readProjectsFromConfig (Controls.Item("txtPath").value)
End Sub
Cold anyone tell me how to create code based (during runtime) text boxes and command buttons and add events to them?
See Gary's answer to a similar question on SO. You can do it using a class and declaring it WithEvents.
You only get a shared event handler, but you can switch actions based on the calling control.
Tim
When I want to dynamically add controls on a userform I just go the route of adding the controls to a withevents class that I created similar to what is found here.