VBA 如何访问工作表中的所有 ActiveX 控件，甚至是组中的控件

Question

我想访问工作表中的所有 ActiveX 复选框和选项按钮。我试图为此创建一个循环，但我的循环无法获取所有这些。

查了查不出来的名字后，发现是分组的（选择它们，右键，分组）。即使它们被分组，如何访问我在工作表中的所有控件？

这是我现在使用的代码，它允许我直接在工作表中的控件未分组，但它不允许我获得分组控件。

我正在阅读用户填写的表格，一些用户已经对控件进行了分组，而其他用户没有，这就是为什么我不能提前知道控件是否被分组，所以我需要访问所有它们在我的代码读取的当前工作表中。

'ws is my worksheet

Dim obj As OLEObject

For Each obj In ws.OLEObjects
  Debug.Print obj.Name
Next obj
End If

Answer 1

要获取所有 ActiveX 对象，即使放入一个组中，也要从使用 Shapes-Collection 而不是 OLEObjects-Collection 开始。

您可以检查形状的Type = msoOLEControlObject (12)，以便仅列出OLEObjects。组的类型为msoGroup (6)，并有一个集合GroupItems，其中包含该组中的所有形状。

你可以编写一个递归例程。看下面的代码写所有的OLEObjects。

更新：代码现在创建一个字典，其中包含所有 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

取消组合：

Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If sh.Type = msoGroup Then sh.Ungroup
Next sh

Answer 2

我认为访问所有 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 只是一个辅助函数，用于创建两个集合的联合。在我的代码中，Example 检索 ActiveSheet 上的 OleObjects 集合，通过调用 FilterOleObjectsByType 将其过滤为仅包含 CheckBoxes 和 OptionBoxes，然后打印每个名称。然而，一旦你有了这个收藏，你就可以用它做任何事情。

我认为我的解决方案的优点是对象的枚举与您想要对它们执行的实际任务分离。您只需在代码中的某处包含这三个函数，然后从您的代码部分调用 CollectOleObjectsOnWorksheet。

更新：

我修改了代码：(​​1) OleObjects 可能有 msoOLEControlObject，(2) 我添加了一个 Function 来过滤检索到的对象，这样它们就只包含 CheckBoxes 和 OptionBoxes。

我不建议对形状进行分组和取消分组，因为您可以使用我的代码访问这些对象，而无需修改原始文档。但是，如果您需要这样做，您可以调用 Shape 的 .Ungroup 方法将它们取消组合，或者调用 ShapeRange 的 .Group 方法。后者有点棘手，因为您必须在 Worksheet.Shapes.Range(Array("ShapeName1", "ShapeName2")) 或 Shape.GroupItems.Range(Array("ShapeName1", "ShapeName2")) 返回的对象上调用它。