Question

我想访问工作表中的所有ActiveX CheckBox和OptionButton。我尝试为此创建一个循环，但是我的循环无法获取所有这些循环。

在检查我无法获得的名称后，我发现它们已被分组（通过选择它们，右键单击，将它们分组）。即使将所有控件分组，如何访问工作表中的所有控件？

这是我现在正在使用的代码，它使我可以直接将不在工作表中的控件分组，但不允许我将其分组。

我正在阅读用户填写的工作表，有些用户将控件分组，而另一些则没有，这就是为什么我不能真正提前知道控件是否分组的原因，因此我需要访问所有它们在我的代码读取的当前工作表中。

'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，该集合包含该组中的所有形状。

您可以编写一个递归例程。请参阅下面的代码来编写所有OLEObject。

更新：现在，代码创建了一个包含所有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返回工作表上所有OleObject的集合，该集合作为一个参数建立，该参数基于递归枚举CollectOleObjectsOfShape提供的OleObject的功能。 CollectionAddElements只是一个帮助函数，用于创建两个Collections的并集。在我的代码中，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"))返回的对象上调用它。

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

2 个答案: