Я думаю, что это важная задача для достижения всех 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на рабочем листе, представленном как параметр, основанный на функциональности рекурсивного перечисления объектов OleObject, предоставляемых CollectOleObjectsOfShape.CollectionAddElements - это просто вспомогательная функция для создания объединения двух коллекций.В моем коде Пример извлекает коллекцию OleObjects в ActiveSheet, фильтрует ее, чтобы включить только CheckBoxes и OptionBoxes, вызывая FilterOleObjectsByType, а затем печатает имя каждого из них.Однако, получив эту коллекцию, вы можете делать с ней все, что угодно.
Я думаю, что преимущество моего решения состоит в том, что перечисление объектов отделено от фактической задачи, которую вы хотите с ними выполнить.Вам просто нужно включить три функции где-нибудь в коде и вызвать CollectOleObjectsOnWorksheet из вашей части кода.
Обновление:
Я изменил код: (1)OleObjects может иметь msoOLEControlObject, (2) я добавил функцию для фильтрации извлеченных объектов, чтобы они включали только CheckBoxes и OptionBoxes.
Я бы не рекомендовал группировать и разгруппировать Shapes, потому что вы можете получить доступ к этим объектам с помощьюмой код без изменения исходного документа.Однако, если вам нужно это сделать, вы можете вызвать метод ShapeRange .Ungroup Shape, чтобы разгруппировать их, или метод ShapeRange .Group.Последнее немного сложнее, потому что вы должны вызывать его для объекта, возвращаемого Worksheet.Shapes.Range(Array("ShapeName1", "ShapeName2")) или Shape.GroupItems.Range(Array("ShapeName1", "ShapeName2")).