Excel VBA中如何通过progID获取对应的OLEObject对象？

Excel 并未为OLEObjects集合提供按ProgID直接索引的内置检索能力，常规实现逻辑为遍历目标工作表下的所有OLE对象，逐一对每个对象的progID属性值做匹配，命中后返回对应对象实例即可。

• 先明确匹配规则：progID属性值是严格区分大小写的完整标识，通常会附带版本后缀（比如标准ActiveX控件的ProgID格式为Forms.控件名.版本号），需要根据实际需求确认是全值严格匹配，还是忽略版本号做模糊匹配。
• 封装通用匹配函数：把遍历逻辑封装成可复用的VBA函数，减少重复代码。

Function GetOLEObjectByProgID(ws As Worksheet, targetProgID As String, Optional matchExact As Boolean = True) As Object
    Dim oleObj As OLEObject
    For Each oleObj In ws.OLEObjects
        If matchExact Then
            ' 执行ProgID全值严格匹配
            If UCase(oleObj.progID) = UCase(targetProgID) Then
                Set GetOLEObjectByProgID = oleObj
                Exit Function
            End If
        Else
            ' 忽略版本后缀，仅匹配ProgID主名称
            Dim sourceMainName As String, targetMainName As String
            sourceMainName = Split(oleObj.progID, ".")(0)
            targetMainName = Split(targetProgID, ".")(0)
            If UCase(sourceMainName) = UCase(targetMainName) Then
                Set GetOLEObjectByProgID = oleObj
                Exit Function
            End If
        End If
    Next oleObj
    ' 未匹配到对应对象时返回空值
    Set GetOLEObjectByProgID = Nothing
End Function

函数调用示例 #

Sub MatchOLEObjectDemo()
    Dim targetObj As OLEObject
    ' 在Sheet1中检索对应ProgID的对象
    Set targetObj = GetOLEObjectByProgID(ThisWorkbook.Worksheets("Sheet1"), "Forms.CommandButton.1", True)
    
    If Not targetObj Is Nothing Then
        MsgBox "匹配成功，对象名称为：" & targetObj.Name
    Else
        MsgBox "当前工作表下未找到对应ProgID的OLE对象"
    End If
End Sub

• 注意事项：

• 代码中统一对ProgID值做大写转换后再对比，可规避大小写书写不一致导致的匹配失效问题
• 若同一工作表下存在多个ProgID完全相同的对象，上述单值返回逻辑会返回遍历过程中第一个命中的对象；如果需要获取所有同ProgID的对象，可调整函数返回值为自定义集合，将所有命中的OLEObject依次存入集合后返回
• 跨工作表检索时，只需在原有遍历逻辑外层增加一层工作簿所有工作表的循环即可，核心匹配逻辑和单工作表场景完全一致

内容的提问来源于stack exchange，提问作者PaichengWu