CODEWITHSUNDEEP
vbaexcelpowerpoint
David G
David G

Reputation: 2347

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

Upvotes: 1

Views: 8073

Answers (2)

David Zemens
David Zemens

Reputation: 53623

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

Upvotes: 1

Shai Rado
Shai Rado

Reputation: 33682

I am using a slightly different code:

ppProgram is PowerPoint.Application

ppPres is PowerPoint.Presentation

ppFullPath is the full path (Path & File Name)

ppName is the "clean" Name of the requested Presentation

' more than 1 Presentstion open
If ppProgram.Presentations.Count > 0 Then
    ppName = Mid(ppFullPath, InStrRev(ppFullPath, "\") + 1, Len(ppFullPath))
    i = 1
    Do Until i = ppProgram.Presentations.Count + 1
        If ppProgram.Presentations.Item(i).Name = ppName Then
            Set ppPres = ppProgram.Presentations.Item(i)
            GoTo OnePager_Pres_Found
        Else
            i = i + 1
        End If
    Loop
End If

OnePager_Pres_Found:
ppPres.Windows(1).Activate  ' activate the Presentation in case you have several open

Upvotes: 0

Related Questions