Excel-VBA - Liste Kontrollen aller Userforms für jede gegebene Arbeitsmappe

Question

Aufgabe

Mein Ziel ist es, alle Kontrollen aller Benutzerformulare für jede gegebene Arbeitsmappe aufzulisten. Mein Code funktioniert für alle Arbeitsmappen innerhalb der Arbeitsmappen-Sammlung andere als die aufrufende Arbeitsmappe (ThisWorkBook).

Problem

Wenn ich versuche, alle Steuerelemente Userforms zur Liste in Bezug auf den Aufruf Arbeitsmappe, erhalte ich Fehler 91 Objektvariable oder With-Blockvariable nicht gesetzt an nummerierten Fehlerzeile 200 (so genannten ERL). Der folgende Code ist in 2 redundante Teile, um den Fehler explizit zu zeigen. Jede Hilfe wird geschätzt.

-Code

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 

Helper Funktion

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 

Answer 1

Wenn ein Formular angezeigt wird, können Sie nicht programmatischen Zugriff auf seine Designer bekommen. Sie rufen ListWBControls von einem geöffneten UserForm. Sie könnten das Formular vorher schließen und den Code, der es zuerst geöffnet hat, die Liste erstellen und danach erneut öffnen.

Beispiel

Dieser Code in einem Modul geht:

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 

Dieser Code geht in UserForm1, wo Sie eine Befehls cmdDoList genannt gesetzt haben:

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 

Die Idee ist, Um das Formular zu schließen, listet die Steuerelemente auf und öffnet das Formular erneut, wenn auf cmdDoList geklickt wird, und um das Formular zu schließen, wenn es korrekt ist wird mit der X-Taste abgelehnt.

Answer 2

Gefunden eine direkte Lösung Abdeckung den meisten Fällen unter Verwendung der Klasse Eigenschaften von Userforms und VBComponents.

Ich zeige intensiv den geänderten Code unten anstatt neu zu bearbeiten. Natürlich, ich schätzen die bereits akzeptierte Lösung von @Excelosaurus :-)

Hintergrund

• VBComponents eine .HasOpenDesigner Eigenschaft.
• Die aufrufende userForm hat die Klasse Eigenschaften .Controls UND kann über die Kennung Me referenziert werden.
• (nur der dritte seltene Fall bleibt ungelöst und nur, wenn ich diese UFs nicht direkt referenziere: wie andere Benutzerformulare durch eine Namenszeichenfolge in der aufrufenden Datei IF sind sie aktiv = .HasOpenDesigner ist falsch, vielleicht ein Wert wert neue Frage)

Modified Code

Sub ListWBControls2() 
' Purpose: list ALL userform controls of a given workbook within workbooks collection 
' cf.: https://stackoverflow.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 

Helper Funktion

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