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

时间:2014-08-11 16:29:51

标签: excel-vba userform vba excel

我正在更新用户表单,并在不同的选项卡上添加了更多控件。我正准备更新我的Initialize子,并想知道是否有一个功能允许我列出和/或打印表单上的所有控件对象?

让他们的其他属性也会膨胀,因为它会给我一张我需要设置的地图,并将其用作清单以确保我完成所需的一切。这样做比通过它们更有效,希望我有正确的名称和细胞参考,洗/漂洗/重复。

由于

2 个答案:

答案 0 :(得分:0)

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 

这非常有效,将所有控件添加到手动创建的工作表中。请务必阅读评论并对各个项目进行必要的更改。

感谢OzGrid的人们在很多个月前回答过这个问题。经验教训:只要您有选择,就可以继续在Google中尝试不同的单词。

答案 1 :(得分:0)

我最近有类似的要求,并从上面的JSM代码开始。有350个控件嵌套在Frames和Multipages中,我很难跟踪"其中"每个控件都在UserForm中。

下面的解决方案将控制对象存储为字典中的键,并将其路径存储为每个祖先的控制对象数组。将字典调暗为在模块的其他部分中使用的公共有助于循环字典对象(和/或任何父对象)以查找或更改这些对象的属性(字体,颜色等)。

如果只需要更新字典,则可以选择创建或覆盖现有工作表。排序基于框架内的标签索引(以及多页中页面的索引),我选择过滤掉初始视图的标签。

在另一个模块中对以下内容进行了调暗,因此可以在别处使用字典:

Public usrFm As Object
Public dPath As New Scripting.Dictionary

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

输出示例如下: output

  

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

考虑基于0的索引:

&#34;的 v1_Cmb_Name &#34;是一个 ComboBox ,可以在UserForm&gt;中找到MultiPage(第8个标签元素)&gt;多页内的第1页&gt;第1帧(vend_Frm)&gt;第1子帧(v1_Frm)&gt;第二控制