任务
我的目标是列出任何给定工作簿的所有UserForms的所有控件。我的代码适用于工作簿集合中的所有工作簿其他而不是调用工作簿（ThisWorkBook）。
问题
如果我尝试列出所有用户表单关于调用工作簿的控件，我会在编号错误行200处获得错误91对象变量或未设置块变量（所谓的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
答案 0 :(得分：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按钮将表单解除，则关闭表单。
答案 1 :(得分：0)
使用userforms和VBComponents的类属性找到直接解决方案，涵盖大多数情况。
我专心地在下面显示修改后的代码而不是重新编辑。当然，我非常感谢@Excelosaurus已经接受的解决方案:-)
<强>背景
.HasOpenDesigner属性。.Controls并且可以通过标识符Me引用。.HasOpenDesigner是假的;也许值得一个新问题）修改后的代码
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
辅助功能
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