Установите презентацию PowerPoint, когда она уже открыта (из Excel)

Question

Я пытаюсь открыть конкретный слайд PowerPoint, выбранный пользователем в Excel. Код для открытия Powerpoint для конкретного слайда следующего (Тарг является строкой, как "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 

Он работает очень хорошо, когда презентация закрыта, и он должен открыть его. Я хотел бы настроить презентацию Powerpoint на pptPres, когда она уже открыта, поэтому я мог бы заставить код продолжать работать, не открывая новый экземпляр этой презентации. Как я могу получить доступ к приложению в первую очередь и установить презентацию?

Для справки, вот функция, используемая для проверки того, открыт ли PPT.

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 

Answer 1

Я думаю, что это нужно сделать, это:

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

Если вам необходимо активировать презентацию, попробуйте:

VBA.AppActivate (Dir(PptPath))  

Как вы уже отметили, это может также работать в некоторых (см. комментарий Тьерри ниже).

PPTApp.Activate 
PPTPres.Activate 

Answer 2

Я использую немного другой код:

ppProgram является PowerPoint.Application

ppPres является PowerPoint.Presentation

ppFullPath полный путь (Path Name & файла)

ppName является "чистым" Название запрошенной презентации

' 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