我正在更新用户表单,并在不同的选项卡上添加了更多控件。我正准备更新我的Initialize子,并想知道是否有一个功能允许我列出和/或打印表单上的所有控件对象?
让他们的其他属性也会膨胀,因为它会给我一张我需要设置的地图,并将其用作清单以确保我完成所需的一切。这样做比通过它们更有效,希望我有正确的名称和细胞参考,洗/漂洗/重复。
由于
答案 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;第二控制