获取Excel附加为对象的PowerPoint演示文稿的FileName和路径

Question

目标：获取PowerPoint演示文稿的路径和文件名，其中我的当前Excel VBA作为对象附加到其中。

下面的屏幕截图可能更好地解释了我的意思：

这是我以前必须找到所需演示文稿的代码，以防同时打开几个演示文稿（但到目前为止我还无法获得我所在的演示文稿 - 和我不想通过Presntation名称）：

Option Explicit

Sub UpdatePowerPoint(PowerPointFile)

Dim ppProgram                           As Object
Dim ppPres                              As Object
Dim CurOpenPresentation                 As Object

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
        For Each CurOpenPresentation In ppProgram.Presentations ' loop through all open presnetations (check Full Name: Path and name)

            Dim CleanFullName As String * 1024
            CleanFullName = Replace(CurOpenPresentation.FullName, "%20", " ")  ' replace Sharepoint characters %20 with Space ("_")

            If StrComp(PowerPointFile, CleanFullName, vbTextCompare) = 0 Then
                 Set ppPres = CurOpenPresentation
                 Exit For
            End If
        Next CurOpenPresentation
    End If
End If

End Sub

问题：我错过了一个Excel / Office“Trick”，它将Excel文件以某种方式“绑定”在它所在的演示文稿中？也许其他一些解决方案？

Answer 1

沿着这些方向的东西

Sub T()

Dim ppProgram As PowerPoint.Application
Dim ppPresentation As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape As PowerPoint.Shape
Dim objExcel As Excel.Application

Set ppProgram = GetObject(, "PowerPoint.Application")

For Each ppPresentation In ppProgram.Presentations
    For Each ppSlide In ppPresentation.Slides
        For Each ppShape In ppSlide.Shapes
            If ppShape.Type = msoEmbeddedOLEObject Then
                Set objExcel = ppShape.OLEFormat.Object.Application
                if objExcel.ActiveWorkbook.Name=activeworkbook.name then stop
            Else
            End If
        Next ppShape
    Next ppSlide
Next ppPresentation

End Sub