Excel-VBA - 列出任何给定工作簿的所有用户窗体的控件

Posted 2023-02-22

【中文标题】Excel-VBA - 列出任何给定工作簿的所有用户窗体的控件

【英文标题】：Excel-VBA - list controls of all userforms for ANY given workbook

【发布时间】：2018-04-04 07:13:36

【问题描述】：

任务

我的目标是列出任何给定工作簿的所有用户窗体的所有控件。我的代码适用于工作簿集合中的所有工作簿其他而不是调用工作簿 (ThisWorkBook)。

问题

如果我尝试列出有关 调用工作簿 的所有用户窗体控件，我会在编号错误行 200（所谓的ERL)。下面的代码被特意分成 2 个冗余部分，以明确显示错误。任何帮助表示赞赏。

代码

 Sub ListWBControls()
 ' Purpose: list ALL userform controls of a given workbook within workbooks collection
 '
 Dim bProblem As Boolean
 Dim vbc      As VBIDE.VBComponent          ' module, Reference to MS VBA Exte 5.3 needed !!!
 Dim ctrl     As MSForms.Control
 Dim i        As Integer, imax As Integer   ' control counters
 Dim cnr      As Long, vbcnr As Long
 Dim sLit     As String
 Dim sMsg     As String                     ' result string
 Dim owb      As Workbook                   ' workbook object
 Dim wb       As String                     ' workbook name to choose by user
 ' --------------------
 ' choose Workbook name
 ' --------------------
   wb = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 0)  ' << existing workbook name chosen in combobox
 ' check if wb is calling workbook or other
        For Each owb In Workbooks
          If owb.Name = wb And ThisWorkbook.Name = wb Then
             bProblem = True
             Exit For
          End If
        Next owb
 ' count workbooks
   imax = Workbooks.Count
   i = 1
 ' a) start message string showing workbook name
   sMsg = sMsg & vbNewLine & String(25, "=") & vbNewLine & _
          sLit & " WorkBook: " & Workbooks(i).Name & vbNewLine & String(25, "=")
 '------------------------------
 'Loop thru components (modules) - if of UserForm type
 '------------------------------
 For Each vbc In Workbooks(wb).VBProject.VBComponents
  ' Only if Component type is UserForm
    If vbc.Type = vbext_ct_MSForm Then
     ' increment component and ctrl counters
       sLit = Chr(i + 64) & "."
       vbcnr = vbcnr + 1000
       cnr = vbcnr

     ' b) build message new component
       sMsg = sMsg & vbNewLine & String(25, "-") & vbNewLine & sLit & cnr & " '" & _
              vbc.Name & "'" & vbNewLine & String(25, "-")
     '-------------------
     ' Loop thru controls
     '-------------------
     ' ===================================================================
     ' Code is intently broken into 2 portions, to show error explicitly !
     ' ===================================================================
       On Error GoTo OOPS   ' Error handler --> Error 91: Object variable or With block variable not set

       If Not bProblem Then    ' part 1 - other workbooks: shown explicitly, are no problem
100         For Each ctrl In Workbooks(wb).VBProject.VBComponents(vbc.Name).Designer.Controls
             ' increment ctrl counter
               cnr = cnr + 1
             ' c) build messages controls)
               sMsg = sMsg & vbLf & "  " & Format(cnr, "0 000") & " " & ctrlInfo(ctrl)
            Next
        Else                    ' part 2 - problem arises here (wb = calling workbook)
200         For Each ctrl In Workbooks(wb).VBProject.VBComponents(vbc.Name).Designer.Controls    ' << ERROR 91
             ' increment ctrl counter
               cnr = cnr + 1
             ' c) build messages controls)
               sMsg = sMsg & vbLf & "  " & Format(cnr, "0 000") & " " & ctrlInfo(ctrl)
           Next

        End If

       i = i + 1        ' increment letter counter i
    End If
 Next vbc
 ' show result
 Debug.Print sMsg
 Exit Sub

 OOPS:
 MsgBox "Error No " & Err.Number & " " & Err.Description & vbNewLine & _
        "Error Line " & Erl
 End Sub

辅助功能

 Private Function ctrlInfo(ctrl As MSForms.Control) As String
 ' Purpose: helper function returning userform control information
   ctrlInfo = Left(TypeName(ctrl) & String(5, " "), 5) & " " & _
           Left(ctrl.Name & String(20, " "), 20) & vbTab & _
           " .." & IIf(TypeName(ctrl.Parent) = "UserForm", "Me    " & String(15, " "), _
                       TypeName(ctrl.Parent) & ": " & _
                           Left(ctrl.Parent.Caption & String(15, " "), 15)) & vbTab & _
           " T " & Format(ctrl.Top, "# 000") & "/ L " & Format(ctrl.Left, "# 000")
 End Function

【参考方案1】：

使用用户窗体和 VBComponents 的类属性找到了一个直接解决方案，涵盖了大多数情况。

我特意在下面显示修改后的代码，而不是重新编辑。当然，我非常感谢@Excelosaurus 已经接受的解决方案:-)

背景

VBComponents 有一个.HasOpenDesigner 属性。 调用 userForm 具有 class 属性 .Controls 并且可以通过标识符 Me 引用。 （只有第三种很少的情况仍未解决，只有当我不直接引用这些 UF 时：如何通过调用文件中的名称字符串引用其他用户表单

IF

它们是活动的 = @987654324 @ 是错误的；也许值得提出一个新问题）

修改后的代码

 Sub ListWBControls2()
 ' Purpose: list ALL userform controls of a given workbook within workbooks collection
 ' cf.:   https://***.com/questions/46894433/excel-vba-list-controls-of-all-userforms-for-any-given-workbook
 Dim bProblem As Boolean
 Dim vbc      As VBIDE.VBComponent          ' module, Reference to MS VBA Exte 5.3 needed !!!
 Dim ctrl     As MSForms.Control
 Dim i        As Integer, imax As Integer   ' control counters
 Dim cnr      As Long, vbcnr As Long
 Dim sLit     As String
 Dim sMsg     As String                     ' result string
 Dim owb      As Workbook                   ' workbook object
 Dim wb       As String                     ' workbook name to choose by user
 ' ------------------
 ' chosen Workbook
 ' ------------------
     wb = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 0)  ' << existing workbook name chosen in combobox
 ' count workbooks
   imax = Workbooks.Count
   i = 1
 ' a) build message new workbook
   sMsg = sMsg & vbNewLine & String(25, "=") & vbNewLine & _
          sLit & " WorkBook: " & Workbooks(i).Name & vbNewLine & String(25, "=")
 '------------------------------
 'Loop thru components (modules)
 '------------------------------
 For Each vbc In Workbooks(wb).VBProject.VBComponents
  ' Only if Component type is UserForm
    If vbc.Type = vbext_ct_MSForm Then
     ' increment component and ctrl counters
       sLit = Chr(i + 64) & "."
       vbcnr = vbcnr + 1000
       cnr = vbcnr

     ' b) build message new component
       sMsg = sMsg & vbNewLine & String(25, "-") & vbNewLine & sLit & cnr & " '" & _
              vbc.Name & "'" & vbNewLine & String(25, "-")
     '-------------------
     ' Loop thru controls
     '-------------------
       If vbc.HasOpenDesigner Then     ' i) problem for closed userforms in same file resolved
            sMsg = sMsg & vbNewLine & "** " & vbc.Name & " active via Designer.Controls"
            For Each ctrl In Workbooks(wb).VBProject.VBComponents(vbc.Name).Designer.Controls    ' << ERROR 91
               ' increment ctrl counter
                 cnr = cnr + 1
               ' c) build messages controls)
                 sMsg = sMsg & vbLf & "  " & Format(cnr, "0 000") & " " & ctrlInfo(ctrl)
               Next
        ElseIf vbc.Name = Me.Name Then  ' ii) problem for calling userform resolved
              sMsg = sMsg & vbNewLine & "** " & vbc.Name & " active via Me.Controls"
              For Each ctrl In Me.Controls
              ' increment ctrl counter
                cnr = cnr + 1
              ' c) build messages controls)
                sMsg = sMsg & vbLf & "  " & Format(cnr, "0 000") & " " & ctrlInfo(ctrl)

              Next ctrl
                    ' -----------------------------------------------------------
         Else     ' iii) problem reduced to other userforms within the calling file,
                    ' but only IF OPEN
                    ' -----------------------------------------------------------
               sMsg = sMsg & vbLf & "** Cannot read controls in calling file when HasOpenDesigner property is false! **"
          End If
        End If

       i = i + 1        ' increment letter counter i


 Next vbc
 ' show result in textbox
 Me.tbCtrls.Text = sMsg
 Debug.Print sMsg

 End Sub

辅助功能

Private Function ctrlInfo(ctrl As MSForms.Control) As String
' Purpose: helper function returning userform control information
  ctrlInfo = Left(TypeName(ctrl) & String(5, " "), 5) & " " & _
           Left(ctrl.Name & String(20, " "), 20) & vbTab & _
           " .." & IIf(TypeName(ctrl.Parent) = "UserForm", "Me    " & String(15, " "), _
                       TypeName(ctrl.Parent) & ": " & _
                           Left(ctrl.Parent.Caption & String(15, " "), 15)) & vbTab & _
           " T " & Format(ctrl.Top, "# 000") & "/ L " & Format(ctrl.Left, "# 000")
End Function

【参考方案2】：

显示表单时，您无法以编程方式访问其设计器。您正在从打开的用户窗体调用 ListWBControls。您可以事先关闭表单，让最初打开它的代码构建列表，然后重新打开它。

示例

这段代码放在一个模块中：

Public Sub Workaround()
    On Error GoTo errHandler

    Dim frmUserForm1 As UserForm1
    Dim bDone As Boolean

    bDone = False

    Do
        Set frmUserForm1 = New UserForm1
        Load frmUserForm1
        frmUserForm1.Show vbModal

        If frmUserForm1.DoList Then
            Unload frmUserForm1
            Set frmUserForm1 = Nothing

            ListWBControls
        Else
            bDone = True
        End If
    Loop Until bDone

Cleanup:
    On Error Resume Next
    Unload frmUserForm1
    Set frmUserForm1 = Nothing
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Cleanup
End Sub

此代码位于 UserForm1 中，您在其中放置了一个名为 cmdDoList 的 CommandButton：

Option Explicit

Private m_bDoList As Boolean

Public Property Get DoList() As Boolean
    DoList = m_bDoList
End Property

Private Sub cmdDoList_Click()
    m_bDoList = True
    Me.Hide
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = True
    m_bDoList = False
    Me.Hide
End Sub

这个想法是关闭表单，列出控件并在单击 cmdDoList 时重新打开表单，如果使用 X 按钮将其关闭，则永久关闭表单。

【讨论】：

我担心您的有用提示是正确的，即在用户窗体中 没有直接的方法来构建完整列表。不过希望能收到其他想法:-)

使用用户窗体的类方法是一个绝妙的主意。