Search code examples
vbaexcelpowerpoint

Set PowerPoint presentation when already opened (From Excel)


I'm trying to open a specific powerpoint slide decided by the user in Excel. The code to open the Powerpoint to the specific slide is the following (targ is a string like "Slide:12"):

Function rcFollowSlide(targ As String)
    Dim PptPath As String
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation

    targ = Mid(targ, InStr(targ, ":") + 1)
    targ = Left(targ, Len(targ) - 1)
    PptPath = wsSettings.Range("PPTPath").Value

    If IsPPTOpen(PptPath) Then
        MsgBox "Already opened"
        Exit Function
        'Set ppres =
    Else
        Set pptApp = CreateObject("Powerpoint.Application")
        Set pptPres = pptApp.Presentations.Open(PptPath)
    End If

    If targ > 0 And targ <= pptPres.Slides.Count Then
        pptPres.Slides(CInt(targ)).Select
    Else
        MsgBox "Image " & targ & " N/A."
    End If
End Function

It works very well when the presentation is closed and it has to open it up. I'd like to set the Powerpoint presentation to pptPres when it's already opened as well, so I could get the code to continue running without opening a new instance of that presentation. How can I access the application in the first place, and set the presentation?

For reference, here is the function used to check if the PPT is already opened.

Function IsPPTOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsPPTOpen = False
    Case 70:   IsPPTOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Solution

  • I think this should do it:

    If IsPPTOpen(PptPath) Then
        Set pptPres = pptApp.Presentations(Dir(PptPath))
        'Set ppres =
        Exit Function
    Else
    

    If you need to activate the presentation, try:

    VBA.AppActivate (Dir(PptPath))    
    

    As you've noted, this may also work in some cases (see Thierry comment below).

    PPTApp.Activate
    PPTPres.Activate