VBA如何访问工作表中的所有ActiveX控件，甚至组内的控件
我想访问工作表中的所有ActiveX、CheckBoxes和OptionButtons。我试图为此做一个循环，但我的循环不能全部得到。
在检查了那些我无法得到的名字后，我发现它们是分组的(通过选择它们，右键单击，分组)。如何访问工作表中的所有控件，即使它们是分组的？
下面是我现在使用的代码，它允许我获得直接在工作表中的控件，没有分组，但它不允许我获得分组控件。
我正在阅读由用户填充的表单，一些用户已经对控件进行了分组，而另一些用户则没有，这就是为什么我无法预先知道控件是否分组，所以我需要访问我的代码读取的当前工作表中的所有控件。
'ws is my worksheet
Dim obj As OLEObject
For Each obj In ws.OLEObjects
Debug.Print obj.Name
Next obj
End If回答 2
Stack Overflow用户
发布于 2019-03-01 11:22:39
我认为访问所有OLE对象是一项重要的任务，因此我以模块化的方式创建了下面的代码，并在一些示例对象上进行了测试：
Option Explicit
Public Sub Example()
Dim colOleObjects As Collection: Set colOleObjects = CollectOleObjectsOnWorksheet(ActiveSheet)
Dim colCheckboxesAndOptionboxes As Collection: Set colCheckboxesAndOptionboxes = FilterOleObjectsByType(colOleObjects, Array("Forms.CheckBox.1", "Forms.OptionButton.1"))
Dim varItem As Variant: For Each varItem In colCheckboxesAndOptionboxes
Dim shpItem As Shape: Set shpItem = varItem
Debug.Print shpItem.Name
Next varItem
End Sub
Public Function FilterOleObjectsByType(colSource As Collection, varTypes As Variant) As Collection
Dim colDestination As Collection: Set colDestination = New Collection
Dim varElement As Variant: For Each varElement In colSource
Dim shpElement As Shape: Set shpElement = varElement
Dim i As Long: For i = LBound(varTypes) To UBound(varTypes)
If shpElement.OLEFormat.progID = varTypes(i) Then
colDestination.Add shpElement
Exit For
End If
Next i
Next varElement
Set FilterOleObjectsByType = colDestination
End Function
Public Function CollectOleObjectsOnWorksheet(ewsTarget As Worksheet) As Collection
Dim colResult As Collection: Set colResult = New Collection
Dim varChild As Variant: For Each varChild In ewsTarget.Shapes
Dim shpChild As Shape: Set shpChild = varChild
Dim colChild As Collection: Set colChild = CollectOleObjectsOfShape(shpChild)
CollectionAddElements colResult, colChild
Next varChild
Set CollectOleObjectsOnWorksheet = colResult
End Function
Public Function CollectOleObjectsOfShape(shpTarget As Shape) As Collection
Dim colResult As Collection: Set colResult = New Collection
Select Case shpTarget.Type
Case MsoShapeType.msoEmbeddedOLEObject, MsoShapeType.msoOLEControlObject
colResult.Add shpTarget
Case MsoShapeType.msoGroup
Dim varChild As Variant: For Each varChild In shpTarget.GroupItems
Dim shpChild As Shape: Set shpChild = varChild
Dim colChild As Collection: Set colChild = CollectOleObjectsOfShape(shpChild)
CollectionAddElements colResult, colChild
Next varChild
End Select
Set CollectOleObjectsOfShape = colResult
End Function
Public Sub CollectionAddElements(colTarget As Collection, colSource As Collection)
Dim varElement As Variant: For Each varElement In colSource
colTarget.Add varElement
Next varElement
End Sub基本上，CollectOleObjectsOnWorksheet返回工作表上所有OleObjects的集合，该集合作为参数构建，基于CollectOleObjectsOfShape提供的递归枚举OleObjects的功能。CollectionAddElements只是一个创建两个集合的联合的辅助函数。在我的代码中，示例检索OleObjects在ActiveSheet上的集合，通过调用FilterOleObjectsByType将其筛选为只包含CheckBoxes和OptionBoxes，然后打印每个FilterOleObjectsByType的名称。然而，一旦您有了这个集合，您可以使用它做任何事情。
我认为我的解决方案的优点是，对象的枚举与您想要处理的实际任务是解耦的。您只需将这三个函数包含在代码中的某个位置，然后从代码的一部分调用CollectOleObjectsOnWorksheet。
更新：
我修改了代码：(1) OleObjects可能有msoOLEControlObject，(2)我添加了一个函数来过滤检索到的对象，以便它们只包括CheckBoxes和OptionBoxes。
我不建议对形状进行分组和取消分组，因为您可以在不修改原始文档的情况下使用我的代码访问这些对象。但是，如果需要这样做，可以调用形状的.Ungroup方法来取消它们的分组，或者调用ShapeRange的.Group方法。后者比较棘手，因为您必须在Worksheet.Shapes.Range(Array("ShapeName1", "ShapeName2"))或Shape.GroupItems.Range(Array("ShapeName1", "ShapeName2"))返回的对象上调用它。
Stack Overflow用户
发布于 2019-03-01 10:52:54
要获取所有ActiveX对象，即使将其放入组中，也可以从使用Shapes-Collection而不是OLEObjects-Collection开始。
您可以检查形状的Type = msoOLEControlObject (12)，以便只列出OLEObjects。组具有类型msoGroup (6)，并具有一个集合GroupItems，该集合GroupItems包含该组中的所有形状。
您可以编写递归例程。请参阅下面的代码来编写所有OLEObjects。
Update：代码现在创建一个字典，其中包含所有CheckBoxex和RadioButtons以及它们的值。请注意，您需要对脚本库的引用。
Sub ListAllObjects()
Dim ListOfOptions as Dictionary
Set ListOfOptions = New Dictionary
ListObjects ActiveSheet.Shapes, ListOfOptions
End Sub
Sub ListObjects(objArr, ListOfOptions)
Dim sh As Shape
For Each sh In objArr
If sh.Type = msoOLEControlObject Then
' Debug.Print sh.Name; sh.Type; TypeName(sh.OLEFormat.Object.Object)
' Found OptionButton or CheckBox: Add it to Dictionary.
If TypeName(sh.OLEFormat.Object.Object) = "OptionButton" Or TypeName(sh.OLEFormat.Object.Object) = "CheckBox" Then
ListOfOptions.Add sh.Name, sh.OLEFormat.Object.Object.Value
End If
End If
If sh.Type = msoGroup Then
ListObjects sh.GroupItems, ListOfOptions
End If
Next sh
End Sub到Ungroup
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Type = msoGroup Then sh.Ungroup
Next shhttps://stackoverflow.com/questions/54942622
复制相似问题
腾讯云开发者
