Search code examples
vbaexcelpowerpointlate-binding

Error Getting .OLEFormat.Object property of PowerPoint Shape (LateBinding from Excel-VBA)


I have an Excel VBA tool, that resides inside a PowerPoint Presentaion as an EmbeddedOLEObject.

Process work-flow:

  1. A user opens the PowerPoint.
  2. Then opens the Excel embedded object in it.
  3. Running the code in it updates data in the Excel file, and then exports it to the 1st slide of the PowerPoint it was opened from.

The problem starts when the user opens 2 of these PowerPoint presentations. If you open one Presnetation, let's call it "P1", then you open a second presentation "P2". Then you open the embedded Excel file in "P2", the excel gets stuck. When running in debug mode, it goes "crazy" opening numerous VBA windows (without giving an error message), at the following line:

Set objExcel = myShape.OLEFormat.Object.

When running this process the other order, If first you open "P2", and then "P1", open the Embedded Excel file in "P2" it works well.

Anyone got a clue ?

Code

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

Solution

  • Since the aim is to capture the presentation that hosts the embedded workbook, and as you confirmed that it looks to you as a good option, the suggested solution is the capture the ActivePresentation in the Workbook_Open event.

    The risk that you raised is legitimate, it is possible (theoretically, I would say) that the impatient user switches presentations quickly before the workbook loads, but I could not test how likely is this scenario, due to some security alert in my test environment before the wb opens, giving a too large time for that action.

    Awaiting your own confirmation :)