Reputation: 225
I am updating a userform, and have added many more controls on separate tabs. I am getting ready to update my Initialize sub, and was wondering if there is a feature that will allow me to list and/or print all the control-objects on the form?
Having their other properties would be swell as well, since it would give me a map of what I need to set up, as well as use it as a checklist to make sure I complete everything that's needed. It would be more efficient to do that than run through them all, hope I have the right names and cell-references, wash/rinse/repeat.
Thanks
Upvotes: 1
Views: 10592
Reputation: 11
I recently had similar requirements and started with JSM's code above. With 350 controls nested within Frames and Multipages, I was having a difficult time tracing "where" each control sat within the UserForm.
The solution below stores the Control Object as a key in a dictionary and it's path as an Array of Control Objects for each ancestor. Dimming the dictionary as Public to be used in other parts of the module have helped for looping through the dictionary objects (and/or any parent objects) to find or change attributes of those objects (font, color, etc).
Creating or overwriting an existing worksheet is optional in case it is just necessary to update the dictionary. Sorting is based on Tab Index within Frames (and Index for Pages in a Multipage) and I opted to filter out Labels for the initial view.
Dimmed the following in another module so dictionary could be used elsewhere:
Public usrFm As Object
Public dPath As New Scripting.Dictionary
ex: Call DictUserFormControls("EditInvForm",True)
Public Sub DictUserFormControls(userFormName As String, Optional replaceSh As Boolean = False, Optional shName As String = "x_Controls")
Dim i As Long, a As Long, c As Long, pArrLen As Long
Dim cCont As Object, nCont As Object, pArr() As Object
Dim arrLen As Long, h As Long, pgs As Long
Dim pathName As String, tIndex As String, conType As String
Dim extArr As Variant
Set usrFm = VBA.UserForms.Add(userFormName)
If replaceSh = True Then
Dim wb As Workbook, sh As Worksheet, y As Long
Set wb = ActiveWorkbook
'Delete existing sheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
wb.Sheets(shName).Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a new worksheet
Set sh = wb.Worksheets.Add
sh.Name = shName
'Create headers and starting row
sh.Cells(1, 1).value = "Control"
sh.Cells(1, 2).value = "Type"
sh.Cells(1, 3).value = "Path"
y = 2
End If
'loop through all controls associated with UserForm. Find all parents and parents of parents until you reach an error (parent of UserForm)
'add each ancestor's Object to an array, and add the array to a dictionary with the Control Object as the key.
For Each cCont In usrFm.Controls
Set nCont = cCont.Parent
c = 1
a = a + 1
Do Until c = 0
i = i + 1: ReDim Preserve pArr(1 To i)
Set pArr(i) = nCont
dPath(cCont) = pArr
On Error GoTo ErrHandler
Set nCont = nCont.Parent
On Error GoTo 0
Loop
extArr = dPath(cCont)
arrLen = UBound(extArr) - LBound(extArr) + 1
'loop through dict item array backwards for each key to build path names from parent objects stored in array
For h = arrLen To 1 Step -1
'the last item in each array will be the root (with no index or tab index number)
If h = arrLen Then
pathName = extArr(h).Name
Else
'find tab index to help in sorting -- page numbers of multipages are stored as Index not TabIndex
If typeName(extArr(h)) = "Page" Then
tIndex = extArr(h).Index
Else
tIndex = extArr(h).TabIndex
End If
'concatenate 0 to help with sorting (otherwise 10, 11, 12 comes between 1 & 2)
If Len(tIndex) = 1 Then tIndex = "0" & tIndex
pathName = pathName & " | " & "{" & tIndex & "} " & extArr(h).Name
End If
Next h
'position of the control itself
tIndex = cCont.TabIndex
If Len(tIndex) = 1 Then tIndex = "0" & tIndex
pathName = pathName & " | {" & tIndex & "}"
If replaceSh = True Then
'populate rows
sh.Cells(y, 1).value = cCont.Name
'added special condition based on how I name my Labels that are used to display data: determine if "_LblData" is in cCont.Name, if so use LblData for typeName instead of actual typeName
If typeName(cCont) = "Label" And InStr(cCont.Name, "_LblData") <> 0 Then
sh.Cells(y, 2).value = "LabelData"
Else
sh.Cells(y, 2).value = typeName(cCont)
End If
sh.Cells(y, 3).value = pathName
y = y + 1
End If
i = 0
Next cCont
If replaceSh = True Then
Dim fullRng As Range, hdrRng As Range
Set fullRng = sh.Range(Cells(1, 1), Cells(y, 3))
Set hdrRng = sh.Range(Cells(1, 1), Cells(1, 3))
sh.Activate
'format sheet and sort
sh.Sort.SortFields.Clear
sh.Sort.SortFields.Add key:=Range( _
Cells(2, 3), Cells(y, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
sh.Sort.SortFields.Add key:=Range( _
Cells(2, 2), Cells(y, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
sh.Sort.SortFields.Add key:=Range( _
Cells(2, 1), Cells(y, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With sh.Sort
.SetRange Range(Cells(1, 1), Cells(y, 3))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'autofit columns and show filters for header
fullRng.Columns.AutoFit
hdrRng.AutoFilter
'set initial view to display items that require coding
fullRng.AutoFilter Field:=2, Criteria1:=Array( _
"CheckBox", "ComboBox", "CommandButton", "LabelData", "OptionButton", "TextBox"), Operator:= _
xlFilterValues
End If
Exit Sub
ErrHandler:
'root reached
c = c - 1
Resume Next
End Sub
An example of the output is here: output
col1: v1_Cmb_Name
col2: ComboBox
col3: EditInvForm | {07} tabs | {00} vndPg | {00} vend_Frm | {00} v1_Frm | {01}
Considering 0 based index:
"v1_Cmb_Name" is a ComboBox that can be found in the UserForm > MultiPage (8th Tabbed element) > 1st Page within MultiPage > 1st Frame (vend_Frm) > 1st sub-frame (v1_Frm) > 2nd Control
Upvotes: 0
Reputation: 225
Sub ListControls()
Dim lCntr As Long
Dim aCtrls() As Variant
Dim ctlLoop As MSForms.Control
'Change UserForm Name In The Next Line
For Each ctlLoop In MyUserForm.Controls
lCntr = lCntr + 1: Redim Preserve aCtrls(1 To lCntr)
'Gets Type and name of Control
aCtrls(lCntr) = TypeName(ctlLoop)&":"&ctlLoop.Name
Next ctlLoop
'Change Worksheet Name In The Next Line
Worksheets("YrSheetName").Range("A1").Resize(UBound(aCtrls)).Value = Application.Transpose(aCtrls)
End Sub
This worked perfectly, adding all controls to a manually created sheet. Make sure to read comments and make changes required for individual projects.
Thanks to the folks at OzGrid who answered this question many moons ago. Lesson: keep trying different words in Google as long as you have options.
Upvotes: 4