如何在 VBA 表单上列出/打印控件名称和/或属性？

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

提问by JSM

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?

我正在更新用户表单，并在单独的选项卡上添加了更多控件。我准备更新我的 Initialize 子程序，想知道是否有一项功能可以让我列出和/或打印表单上的所有控件对象？

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

谢谢

回答by JSM

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 OzGridwho answered this question many moons ago. Lesson: keep trying different words in Google as long as you have options.

感谢OzGrid的人们在很多个月前回答了这个问题。教训：只要你有选择，就继续在谷歌中尝试不同的词。

回答by mrSteveW

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.

我最近有类似的需求，并从上面的 JSM 代码开始。由于嵌套在框架和多页中的 350 个控件，我很难跟踪每个控件在用户窗体中的“位置”。

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)

例如：调用 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}

col1: v1_Cmb_Name
col2: ComboBox
col3: EditInvForm | {07} 个标签 | {00} vndPg | {00} vend_Frm | {00} v1_Frm | {01}

Considering 0 based index:

考虑基于 0 的索引：

"v1_Cmb_Name" is a ComboBoxthat 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

“ v1_Cmb_Name”是一个组合框，可以在 UserForm > MultiPage (8th Tabbed element) > 1st Page within MultiPage > 1st Frame (vend_Frm) > 1st sub-frame (v1_Frm) > 2nd Control中找到