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

Question

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

处理工作流程:

用户打开 PowerPoint。

然后打开其中的 Excel 嵌入对象。

运行其中的代码会更新 Excel 文件中的数据，然后将其导出到打开它的 PowerPoint 的第一张幻灯片。

问题 当用户打开其中 2 个 PowerPoint 演示文稿时启动。如果您打开一个 Presnetation，我们称之为“ P1 ”，然后您打开第二个演示文稿“ P2 ”。然后在“ P2 ”中打开嵌入的 Excel 文件，Excel 卡住了。在 Debug模式下运行时，它会“疯狂”地打开许多 VBA 窗口(没有给出错误消息)，如下行:
Set objExcel = myShape.OLEFormat.Object .

以其他顺序运行此过程时，如果先打开“ P2 ”，然后打开“ P1 ”，则在“ P2 ”中打开嵌入式 Excel 文件效果很好。

有人有线索吗？

代码

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

由于目标是捕获托管嵌入式工作簿的演示文稿，并且您确认它是一个不错的选择，因此建议的解决方案是捕获 ActivePresentation在 Workbook_Open事件。

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

等待您自己的确认:)