获取 PowerPoint 形状的 .OLEFormat.Object 属性 时出错（LateBinding 来自 Excel-VBA）

Question

我有一个 Excel VBA 工具，它作为 EmbeddedOLEObject 驻留在 PowerPoint 演示文稿中。

处理工作流程：

1. 用户打开 PowerPoint。
2. 然后打开其中的Excel嵌入对象。
3. 运行其中的代码更新Excel文件中的数据，然后将其导出到打开它的PowerPoint的第一张幻灯片。

当用户打开其中 2 个 PowerPoint 演示文稿时，问题 开始出现。如果您打开一个 Presnetation，我们称它为“P1”，然后您打开第二个演示文稿“” P2”。然后你在“P2中打开嵌入的Excel文件，excel卡住了。当 运行 处于调试模式时，它会 "crazy" 打开多个 VBA windows （不给出错误消息），在以下行：

Set objExcel = myShape.OLEFormat.Object.

当运行处理其他命令时，如果先打开“P2”，然后打开“P1",打开"P2[=中的EmbeddedExcel文件53=]" 效果很好。

有人知道吗？

代码

Option Explicit

Public Sub UpdatePowerPoint()

Dim ppProgram                           As Object
Dim ppPres                              As Object
Dim CurOpenPresentation                 As Object
Dim ppSlide                             As Object
Dim myShape                             As Object
Dim SlideNum                            As Integer
Dim objExcel                            As Object
Dim i                                   As Long

On Error Resume Next
Set ppProgram = GetObject(, "PowerPoint.Application")
On Error GoTo 0

If ppProgram Is Nothing Then
    Set ppProgram = CreateObject("PowerPoint.Application")
Else
    If ppProgram.Presentations.Count > 0 Then

        ' loop thorugh all open presentation, then loop through all slides
        ' check each object, check if you find an OLE Embedded object
        For i = 1 To ppProgram.Presentations.Count
            Set CurOpenPresentation = ppProgram.Presentations(i)

            Set ppSlide = CurOpenPresentation.Slides(1) ' only check the first slide for Emb. Excel objects, otherwise not a One-Pager Presentation
                For Each myShape In ppSlide.Shapes
                    Debug.Print myShape.Type & " | " & myShape.Name ' for DEBUG ONLY

                    If myShape.Type = 7 Then ' 7 = msoEmbeddedOLEObject
                        Dim objExcelwbName As String

                        '  ***** ERROR in the Line below *******
                        Set objExcel = myShape.OLEFormat.Object
                        objExcelwbName = objExcel.CustomDocumentProperties.Parent.Name ' get's the workbook name of the Emb. Object

                        If objExcelwbName = ThisWorkbook.Name Then ' compare the name of the workbook the embedded object is in, with ThisWorkbook
                            Set ppPres = CurOpenPresentation
                            GoTo ExitPresFound
                        Else
                            Set objExcel = Nothing ' reset flag
                        End If
                    End If
                Next myShape

NextPresentation:
            Set CurOpenPresentation = Nothing ' clear presentation object
        Next i

    End If ' If ppProgram.Presentations.Count > 0 Then
End If

ExitPresFound:
If ppPres Is Nothing Then ' if One-Pager presentation was not found from all open presentations
    MsgBox "Unable to Locate Presnetation, check if One-Pager Prsentation in Checked-Out (Read-Only Mode)"
End If

End Sub

Answer 1

由于目标是捕获托管嵌入式工作簿的演示文稿，并且您确认它看起来是一个不错的选择，建议的解决方案是捕获 [=11] 中的 ActivePresentation =] 事件.

您提出的风险是合理的，不耐烦的用户可能会在工作簿加载之前快速切换演示文稿（我会说，理论上），但由于某些安全因素，我无法测试这种情况的可能性有多大在 wb 打开之前在我的测试环境中发出警报，为该操作提供了太多时间。

等待您自己的确认:)