Question

我有一个Excel VBA工具，它作为EmbeddedOLEObject驻留在PowerPoint Presentaion中。

流程工作流程：

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

问题在用户打开其中两个PowerPoint演示文稿时启动。如果您打开一个Presnetation，我们称之为“ P1 ”，然后打开第二个演示文稿“ P2 ” 。然后在“ P2 ”中打开嵌入的Excel文件，excel卡住了。在调试模式下运行时，它会“疯狂地”打开多个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打开之前我的测试环境，为该操作提供了太长的时间。

等待您自己的确认：）

获取PowerPoint Shape的.OLEFormat.Object属性时的错误（来自Excel-VBA的LateBinding）

1 个答案: