已打开时设置PowerPoint演示文稿(从Excel)

时间:2016-08-09 18:58:49

标签: excel vba excel-vba powerpoint-vba

我试图在Excel中打开用户决定的特定powerpoint幻灯片。打开Powerpoint到特定幻灯片的代码如下(targ是一个类似"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

2 个答案:

答案 0 :(得分:1)

我认为应该这样做:

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

如果您需要激活演示文稿,请尝试:

VBA.AppActivate (Dir(PptPath))    

正如您所指出的,这在某些情况下也可能有效(请参阅下面的Thierry评论)。

PPTApp.Activate
PPTPres.Activate

答案 1 :(得分:0)

我使用的代码略有不同:

ppProgram PowerPoint.Application

ppPres PowerPoint.Presentation

ppFullPath 是完整路径(路径和文件名)

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