Background:
I have a collection of objects (for this example Listbox objects) in a userform using standardized names, I would like to rename them dynamically using a counter cycle.
Problem:
I have not figured a way if what I am asking is even possible, however, I would like to confirm it.
Solution approach:
Nothing so far, like I said (refer to the image above) I need a way to set the values of the objects within the for cycle, something like this:
For CounterItems = 1 To 18 'Hours in Template
ListBox_Time(CounterItems).Value="Dummy" & CounterItems
Next CounterHours
However, I am clueless on how to do so (or if it is achievable).
Question:
Is there any way to use a counter to cast a variable/object?
No, you can't edit the name while the userform is in use, you'll get error 382
What you'd like to do is this
Option Explicit
Sub test()
Dim myForm As UserForm
Set myForm = UserForm1
Dim myCtrl As Control
Dim i As Long
Dim myCount As Long
myCount = 1
For Each myCtrl In myForm.Controls
If TypeName(myCtrl) = "ListBox" Then
myCtrl.Name = "Dummy" & myCount 'error
myCount = myCount + 1
End If
Next
End Sub
But you'll error when you try to write to the name property. You can print the names or set other properties, but this isn't something you can do as far as I know.
For use with ListBox controls on a UserForm
If you want to change only certain ListBox controls by number:
Public Sub ListBoxNameChange()
Dim ctrl As Control
Dim ctrlName As String, ctrlNum As Integer
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ListBox" Then
ctrlName = ctrl.Name
ctrlNum = CInt(Replace(ctrlName, "ListBox_Time", ""))
If ctrlNum > 0 And ctrlNum < 19 Then
ctrl.AddItem "Dummy" & ctrlNum, 0
End If
End If
Next ctrl
End Sub
If you want to change ALL ListBox controls:
Public Sub ListBoxNameChange2()
Dim ctrl As Control
Dim ctrlName As String
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ListBox" Then _
ctrl.AddItem "Dummy" & Replace(ctrl.Name, "ListBox_Time", ""), 0
Next ctrl
End Sub
I treat them like Shapes and test their pre-defined Names:
Sub ShapeRenamer()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Name = "List Box 6" Then s.Name = "Sixth"
Next s
End Sub
Before:
and after:
You would update this to examine the Shapes in your userform.
You could also do this with an indexing counter.
Related
I'm making a Userform in VBA where I have Text Box's where I can search items. I have about 30 Text Box's so I want to cut down the code using a loop instead of copy and pasting the same code 30 times.
Problem: I don't know how to loop through a public variable
Public Variable: Public oEventHandler(Number) As New clsSearchableDropdown
oEventHandler would go from 1 to 30 (e.g oEventHandler2,oEventHandler3...oEventHandler30)
clsSearchableDropdown is the Class Module for the search feature
Text Box: TextBox(Number)
ListBox: ListBox(Number)
Here is the original code (No Issue Just to Compare):
With oEventHandler1
' Attach the textbox and listbox to the class
Set .SearchListBox = Me.ListBox1
Set .SearchTextBox = Me.TextBox1
' Default settings
.MaxRows = 10
.ShowAllMatches = True
.CompareMethod = vbTextCompare
.WindowsVersion = False
End With
This is what I'm trying to do:
Dim i As Integer
for i = 1 to 30
With Me.Controls.Item("oEventHandler" & i)
' Attach the textbox and listbox to the class
Set .SearchListBox = Me.Controls.Item("ListBox" & i)
Set .SearchTextBox = Me.Controls.Item("TextBox" & i)
' Default settings
.MaxRows = 10
.ShowAllMatches = True
.CompareMethod = vbTextCompare
.WindowsVersion = False
End With
Next i
I know that oEventHandler is not a control but is there a similar code I can use to loop through a public variable?
Here is the code that worked for me:
' Make a New Collection
Dim coll As New Collection
' Add all Public Variables to Collection (n = Number 1 to 30)
coll.Add uQuote.oEventHandler(n)
(e.g oEventHandler1, oEventHandler2... oEventHandler30)
Dim i As Integer
for i = 1 to 30
With coll(i)
' Attach the textbox and listbox to the class
Set .SearchListBox = Me.Controls.Item("ListBox" & i)
Set .SearchTextBox = Me.Controls.Item("TextBox" & i)
' Default settings
.MaxRows = 10
.ShowAllMatches = True
.CompareMethod = vbTextCompare
.WindowsVersion = False
End With
Next i
If I understand you correctly, in the userform you have 30 Textboxes and 30 Listboxes, where each Textbox(N) is to search the value in the Listbox(N) located under that TextBox(N). So it looks something like this :
On the left side is TextBox01, under TextBox01 is ListBox01
On the right side is TextBox02, under TextBox02 is ListBox02
If the animation is similar with your expectation....
Preparation :
Make a named range (as many as needed) with something like List01, List02, List03, and so on for the value to populate each ListBox.
Name each ListBox with something like ListBox01, ListBox02, and so on.
Name each TextBox with something like TextBox01, TextBox02, and so on.
In the Userform module:
Dim MyTextBoxes As Collection
Private Sub UserForm_Initialize()
'populate the ListBoxes with value in a named range
Dim LBname As String: Dim RGname As String: Dim i As Integer
For i = 1 To 2
LBname = "ListBox" & Format(i, "00")
RGname = "List" & Format(i, "00")
Controls(LBname).List = Application.Transpose(Range(RGname))
Next i
'add each TextBox to class
Set MyTextBoxes = New Collection
For Each ctl In Me.Controls
Set TextBoxClass = New Class1
If TypeName(ctl) = "TextBox" And InStr(ctl.Name, "TextBox") Then Set TextBoxClass.obj = ctl
MyTextBoxes.Add TextBoxClass
Next
End Sub
In the Class Module named Class1:
Private WithEvents tb As MSForms.TextBox
Property Set obj(t As MSForms.TextBox)
Set tb = t
End Property
Private Sub tb_Change()
Dim idx As String: Dim LBname As String: Dim arr
idx = Right(tb.Name, 2)
LBname = "ListBox" & idx
arr = Application.Transpose(Range("List" & idx))
With Userform1.Controls(LBname)
If tb.text = "" Then
.Clear
.List = arr
Else
.Clear
For i = LBound(arr, 1) To UBound(arr, 1)
If LCase(arr(i)) Like "*" & LCase(tb.value) & "*" Then .AddItem arr(i)
Next i
End If
End With
End Sub
If in your userform you have another textbox which not to use as a search of the items in respective listbox, then maybe don't name the textbox with "TextBox" but something else, for example "blablabla".
if your existing textbox and listbox already named something like ListBox1, ListBox2, ListBox3 and so on, TextBox1, TextBox2, TextBox3 and so on... then name the named range like List1, List2, List3 and so on. In the class module, change the code for idx using the replace method, something like idx = replace(tb.name,"TextBox",""). Also in the Userform module for LBname and RGname use the replace method.
Because I'm limited in English language, I'm sorry I can't detail the code for further explanation.
I currently have a code that creates text boxes dynamically on a userform back story is here.
In the code it checks a single frame on the form for controls and if any are ticked then it runs this code:
Function Addcheckboxes(emailtype)
Dim Ctrl As Control
Dim cont As Control
Dim i As Long
Dim h As Long
Dim intAppCount As Integer
Dim result As Long
' Loop through all the applications that have been selected with the email type and then create the appropriate email template on the userform lower box
If SpnColct.Count > 0 Then removeDynamicControls
For Each Ctrl In Me.Frame4.Controls
If TypeOf Ctrl Is MSForms.CheckBox Then
If Ctrl = True Then
Call AddTextBox(Mid(Ctrl.Name, 4), emailtype)
intAppCount = intAppCount + 1
End If
End If
Next
If intAppCount > 1 Then Me.Frame3.Caption = "Email Templates"
End Function
How do I expand this to make it check both Frame 4 and Frame 5 on the userform ?
Thank you in advance
You can loop through each frame as follows...
Dim Frm As Variant
For Each Frm In Array(Me.Frame4, Me.Frame5)
For Each Ctrl In Frm.Controls
If TypeOf Ctrl Is MSForms.CheckBox Then
If Ctrl = True Then
Call AddTextbox(Mid(Ctrl.Name, 4), emailtype)
intAppCount = intAppCount + 1
End If
End If
Next
Next Frm
I have a VBA application with a lot of controls.
I would like accessing the controls with an order of reading during For-Next loop.
' Parcours des contrôles de l'userform
For Each cCont In Me.Controls
' TypeName(cCont)
MsgBox (cCont.Name)
Next cCont
Actually, I think I am accessing with creation date...
Do you know if I could configure the order of reading ?
Thanks
One way to do this is to sort them by the TabIndex property. Set the tab indices to the desired order, then use this:
Private Sub test()
Dim cCont As Control
Dim i As Integer
Dim maxIndex As Integer
Dim controls As Object
Dim key As Variant
Set controls = CreateObject("Scripting.Dictionary")
'Add controls to dictionary, key by tabindex property
For Each cCont In Me.controls
maxIndex = IIf(maxIndex < cCont.TabIndex, cCont.TabIndex, maxIndex)
controls.Add cCont.TabIndex, cCont
Next cCont
'Get controls in order
For i = 0 To maxIndex
If controls.exists(i) Then
MsgBox controls(i).Name
End If
Next i
End Sub
The posted code is a great solution, which I made workable for me with this minor change. I passed the user form, because I used the code in a module. I excluded Label, CommandButton, and Image in order to make Valon Miller's code work for me, otherwise the depicted runtime error wouldruntime error '-2147352573 (800 200037': Member not found show.
Private Sub test(frm As UserForm)
Dim cCont As Control
Dim i As Integer
Dim maxIndex As Integer
Dim controls As Object
Dim key As Variant
Set controls = CreateObject("Scripting.Dictionary")
'Add controls to dictionary, key by tabindex property
For Each cCont In frm.controls
If TypeName(cCont) <> "Label" And _
TypeName(cCont) <> "Image" And _
TypeName(cCont) <> "CommandButton" Then
maxIndex = IIf(maxIndex < cCont.TabIndex, cCont.TabIndex, maxIndex)
controls.Add cCont.TabIndex, cCont
End If
Next cCont
'Get controls in order
For i = 0 To maxIndex
If controls.exists(i) Then
Debug.Print controls(i).Name & vbTab & i
MsgBox controls(i).Name
End If
Next i
End Sub
--------------------------------------------
Originally I needed a solution to get the order of sql statements synced with the order of my form controls. I wanted to do this:
fld1 = recordset1.value
fld2 = recordset2.value
fld3 = recordset3.value
was looking for a solution to get my controls and my SQL statement in order like field1 -> recordset.value1.
So instead of ordering my controls using the taborder, I created control arrays. i.e.
sub useControlArray()
dim a as variant, rs as new recordset, strSQL as string
strSQL = "select fld1, fld2, fld3 from table"
rs.open strSQL, connection
a = array("fld1", "fld2", "fld3")
'This array would help like this:
for i = lbound(a) to ubound(a)
frm.controls(a(i)) = rs(i)
debug.print frm.controls(a(i)) ' Form is a user form
next i
end sub
This would restrict the controls to the number of controls needed to fill them using the same order as in my SQL statement and I did not need to pay attention to whether or not a control would exist.
I hope this is helpful.
I'm having a problem assigning VBA generated ActiveX checkboxes to a class module. When a user clicks a button, the goal of what I am trying to achieve is: 1st - delete all the checkboxes on the excel sheet; 2nd - auto generate a bunch of checkboxes; 3rd - assign a class module to these new checkboxes so when the user subsequently clicks one of them, the class module runs.
I've borrowed heavily from previous posts Make vba code work for all boxes
The problem I've having is that the 3rd routine (to assign a class module to the new checkboxes) doesn't work when run subsequently to the first 2 routines. It runs fine if run standalone after the checkboxes have been created. From the best I can tell, it appears VBA isn't "releasing" the checkboxes after they have been created to allow the class module to be assigned.
The below code is the simplified code that demonstrates this problem. In this code, I use a button on "Sheet1" to run Sub RunMyCheckBoxes(). When button 1 is clicked, the class module did not get assigned to the newly generated checkboxes. I use button 2 on "Sheet1" to run Sub RunAfter(). If button 2 is clicked after button 1 has been clicked, the checkboxes will be assigned to the class module. I can't figure out why the class module won't be assigned if just the first button is clicked. Help please.
Module1:
Public mcolEvents As Collection
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Call SetCBAction("Sheet1")
End Sub
Sub DeleteAllCheckboxesOnSheet(SheetName As String)
Dim obj As OLEObject
For Each obj In Sheets(SheetName).OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
obj.Delete
End If
Next
End Sub
Sub InsertCheckBoxes(SheetName As String, CellRow As Double, CellColumn As Double, CBName As String)
Dim CellLeft As Double
Dim CellWidth As Double
Dim CellTop As Double
Dim CellHeight As Double
Dim CellHCenter As Double
Dim CellVCenter As Double
CellLeft = Sheets(SheetName).Cells(CellRow, CellColumn).Left
CellWidth = Sheets(SheetName).Cells(CellRow, CellColumn).Width
CellTop = Sheets(SheetName).Cells(CellRow, CellColumn).Top
CellHeight = Sheets(SheetName).Cells(CellRow, CellColumn).Height
CellHCenter = CellLeft + CellWidth / 2
CellVCenter = CellTop + CellHeight / 2
With Sheets(SheetName).OLEObjects.Add(classtype:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=CellHCenter - 8, Top:=CellVCenter - 8, Width:=16, Height:=16)
.Name = CBName
.Object.Caption = ""
.Object.BackStyle = 0
.ShapeRange.Fill.Transparency = 1#
End With
End Sub
Sub SetCBAction(SheetName)
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets(SheetName).OLEObjects
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
Sub RunAfter()
Call SetCBAction("Sheet1")
End Sub
Class Module (clsActiveXEvents):
Option Explicit
Public WithEvents mCheckBoxes As MSForms.CheckBox
Private Sub mCheckBoxes_click()
MsgBox "test"
End Sub
UPDATE:
On further research, there is a solution posted in the bottom answer here:
Creating events for checkbox at runtime Excel VBA
Apparently you need to force Excel VBA to run on time now:
Application.OnTime Now ""
Edited lines of code that works to resolve this issue:
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Application.OnTime Now, "SetCBAction" '''This is the line that changed
End Sub
And, with this new formatting:
Sub SetCBAction() ''''no longer passing sheet name with new format
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets("Sheet1").OLEObjects '''''No longer passing sheet name with new format
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
If OLE objects suit your needs then I'm glad you've found a solution.
Are you aware, though, that Excel's Checkbox object could make this task considerably simpler ... and faster? Its simplicity lies in the fact that you can easily iterate the Checkboxes collection and that you can access its .OnAction property. It is also easy to identify the 'sender' by exploiting the Evaluate function. It has some formatting functions if you need to tailor its appearance.
If you're after something quick and easy then the sample below will give you an idea of how your entire task could be codified:
Public Sub RunMe()
Const BOX_SIZE As Integer = 16
Dim ws As Worksheet
Dim cell As Range
Dim cbox As CheckBox
Dim i As Integer, j As Integer
Dim boxLeft As Double, boxTop As Double
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Delete checkboxes
For Each cbox In ws.CheckBoxes
cbox.Delete
Next
'Add checkboxes
For i = 1 To 10
For j = 1 To 2
Set cell = ws.Cells(i, j)
With cell
boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
End With
Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
With cbox
.Name = "CB" & i & j
.Caption = ""
.OnAction = "CheckBox_Clicked"
End With
Next
Next
End Sub
Sub CheckBox_Clicked()
Dim sender As CheckBox
Set sender = Evaluate(Application.Caller)
MsgBox sender.Name & " now " & IIf(sender.Value = 1, "Checked", "Unchecked")
End Sub
I have an Excel userform with dynamically added checkboxes.
I add the checkboxes with code that looks like this:
Set chkBox = Me.Controls.Add("Forms.Checkbox.1", "Checkbox" & i)
I want to remove all of these checkboxes.
Dim j As Integer
'Remove all dynamically updated checkboxes
For Each cont In Me.Controls
For j = 1 To NumControls
If cont.Name = "Checkbox" & j Then
Me.Controls.Remove ("Checkbox" & j)
End If
Next j
Next cont
I get the following error message:
A better approach may be to keep track of the controls you create (eg in a collection), and use that to remove them.
This way your code is not bound to the name format, and can be applied to other control types too.
Private cbxs As Collection
Private Sub UserForm_Initialize()
Set cbxs = New Collection
End Sub
' Remove all dynamicly added Controls
Private Sub btnRemove_Click()
Dim i As Long
Do While cbxs.Count > 0
Me.Controls.Remove cbxs.Item(1).Name
cbxs.Remove 1
Loop
End Sub
' Add some Controls, example for testing purposes
Private Sub btnAdd_Click()
Dim i As Long
Dim chkBox As Control
For i = 1 To 10
Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "SomeRandomName" & i)
chkBox.Top = 40 + i * 20
chkBox.Left = 20
cbxs.Add chkBox, chkBox.Name '- populate tracking collection
Next
' Demo that it works for other control types
For i = 1 To 10
Set chkBox = Me.Controls.Add("Forms.ListBox.1", "SomeOtherRandomName" & i)
chkBox.Top = 40 + i * 20
chkBox.Left = 60
cbxs.Add chkBox, chkBox.Name
Next
End Sub
Assuming there are no othe control names starting with "Checkbox",
For Each cont In Me.Controls
If InStr(cont.Name, "Checkbox") = 1 Then
Me.Controls.Remove cont.Name
End If
Next cont
if you already know the name of the controls, the type, and how many, why double loop ?
note that ONLY controls created at runtime can be removed.
'the following removes all controls created at runtime
Dim i As Long
On Error Resume Next
With Me.Controls
For i = .Count - 1 to 0 step -1
.Remove i
Next i
End With
Err.Clear: On Error GoTo 0
and for your case : 'if all naming are correct
Dim j&
For j = 1 To NumControls
Me.Controls.Remove "Checkbox" & j
Next j
Adding a check for the control seemed to fix this. Not entirely sure why, but it works.
Dim j As Integer
'Remove all dynamically updated checkboxes
For Each cont In Me.Controls
If TypeName(cont) = "CheckBox" Then
For j = 1 To NumControls
If cont.Name = "Checkbox" & j Then
Me.Controls.Remove cont.Name
Exit For
End If
Next j
End If
Next cont
I rewrote the original code using command buttons, and just added "Me.Controls.Count" rather than "NumControls" and defined "Cont" as a Control. It seems to be working for me. Please let me know if this works for you:
-->
On Error Resume Next
Dim Cont As Control
Dim C As Integer
'Remove all dynamically updated checkboxes
For Each Cont In Me.Controls
For C = 1 To Me.Controls.Count
If Cont.Name = "CommandButton" & C Then
Me.Controls.Remove ("CommandButton" & C)
End If
Next C
Next Cont
Another way to select which controls are kept and which are deleted is to use the .Tag attribute.
This allows some fine control of the controls as they are added, for example by using the .Tag as a bitfield.
At creation time:
With Me.Controls.add("Forms.Label.1", Visible:=True)
{code}
.Tag = 1
{more code}
Then when the time comes to tidy up:
For Each C In Me.Controls
If C.Tag = 1 Then Me.Controls.Remove C.Name
Next