JSM
JSM

Reputation: 225

How do I list/print control names and/or properties on a VBA form?

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

Answers (2)

mrSteveW
mrSteveW

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

JSM
JSM

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

Related Questions