I have an Excel VBA tool, that resides inside a PowerPoint Presentaion as an EmbeddedOLEObject.
Process work-flow:
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
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 :)