Excel to PowerPoint (VBA) (Referencing the right PowerPoint instance)

[thesnowplow]

Below code works perfectly:

Sub ExportToPowerPoint()


'early binding
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim SlideCount As Long


' Reference instance of PowerPoint
On Error Resume Next
' Check whether PowerPoint is running
Set ppApp = GetObject(, "PowerPoint.Application")
If ppApp Is Nothing Then
    ' PowerPoint is not running, create new instance
    Set ppApp = CreateObject("PowerPoint.Application")
    ' For automation to work, PowerPoint must be visible
    ppApp.Visible = True
    ppApp.Activate
End If
On Error GoTo 0


' Reference presentation and slide
On Error Resume Next
If ppApp.Windows.Count > 0 Then
    ' There is at least one presentation
    ' Use existing presentation
    Set ppPres = ppApp.ActivePresentation
    ' Use active slide
    Set ppSlide = ppPres.Slides _
        (ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)
Else
    ' There are no presentations
    ' Create new presentation
    Set ppPres = ppApp.Presentations.Add
    'apply theme
    On Error Resume Next
    ppPres.ApplyTemplate ("S:\Public\TechnicalTemplate\Technical.potx")
    On Error GoTo 0
    ' Add first slide
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutTitle)
    ppSlide.Shapes(1).TextFrame.TextRange.Text = "Quality Review"
    ppSlide.Shapes(2).TextFrame.TextRange.Text = "by " & Application.UserName
End If
On Error GoTo 0


'Finding how many slide are in ppPres
SlideCount = ppPres.Slides.Count
'based on total slide count, add a new one at the end
Set ppSlide = ppPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
ppSlide.Select


'copy chart from excel
Sheets("Dashboard").ChartObjects("Chart 1").Copy
'paste chart as picture into the newly added slide
ppSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile


End Sub

Description: This macro adds 2 slides - if there is no instance of PowerPoint open it will open a new instance and add intro slide and second slide with graph. If there is instance of PowerPoint already open, it will skip the intro slide and will only add slide with graph.


Problem: If user has e.g. 5 PowerPoint instances open the code will pick "ActivePresentation" which could be any of them for the end user and will start inserting slides in potentially wrong ppPres.


Solution: I need to somehow reference the "correct" PowerPoint file that has the intro slide without having to save it and make sure the code uses it as the ActivePresentation. If one cannot be found then create a new instance. Something like If ppApp.Windows.Count > 0 Then loop through all ppApp open windows and find a ppPres that is not saved (ppPres.Path <> "" ??) AND 1st slide Shapes(1).TextFrame.TextRange.Text = "Quality Review" IF found then make that the ActivePresentation ELSE create a new instance.


Is this possible?

 

[thesnowplow]

Found the solution myself:

[FONT=&quot]Dim X As Integer ' Reference presentation and slideOn Error Resume NextIf ppApp.Windows.Count > 0 Then    For X = 1 To ppApp.Windows.Count        If ppApp.Windows(X).Presentation.Path = "" And ppApp.Windows(X).Presentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = "Quality Review" Then            ppApp.Windows(X).Activate            Set ppPres = ppApp.ActivePresentation            Set ppSlide = ppPres.Slides _        (ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)        End If    Next XElseLine2:    ' There are no presentations    ' Create new presentation    Set ppPres = ppApp.Presentations.Add    'apply theme    On Error Resume Next    ppPres.ApplyTemplate ("S:\Public\TechnicalTemplate\Technical.potx")    On Error GoTo 0    ' Add first slide    Set ppSlide = ppPres.Slides.Add(1, ppLayoutTitle)    ppSlide.Shapes(1).TextFrame.TextRange.Text = "Quality Review"    ppSlide.Shapes(2).TextFrame.TextRange.Text = "by " & Application.UserNameEnd IfOn Error GoTo 0If ppPres Is Nothing ThenGoTo Line2End If[/FONT]