Vba 如何检查PowerPoint文件是否已打开？

我正在尝试创建MS Word宏，以检查特定powerpoint文件是否打开。如果是，那么我希望它转到下一个，如果不是，那么打开文件

Public Sub CommandButton1_Click()
Dim pptApp As Object
Dim pptPres As String
'Dim nSlide As PowerPoint.Presentation
Dim folderPath, file As String

folderPath = ActiveDocument.Path & Application.PathSeparator
file = "Huntington_Template.pptx"

Set pptApp = CreateObject("PowerPoint.Application")

If pptApp.presentations(file).Enabled = True Then
    GoTo cont
Else
    pptApp.Visible = True
    pptApp.presentations.Open (folderPath & file)
End If

续：

将此添加到您的模块（aircode，可能需要调试帮助）：

然后，代替您的：

If pptApp.presentations(file).Enabled = True Then

使用：

---

我使用此函数确定工作簿是否已打开，它可能适用于powerpoint

Public Function IsWorkBookOpen(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:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

然后你可以通过这样做来调用它

Ret = IsWorkBookOpen("C:\Book1.xlsm")
 If Ret = True Then
    Set wb = Application.Workbooks("C:\Book1.xlsm")
    wb.Activate
Else
    Set wb = Application.Workbooks.Open("C:\Book1.xlsm")
End If

---

Steve代码的一个小变化，以防您不仅要测试演示文稿是否打开，还要直接使用它：

Function GetPowerpointFileIfOpen(pptApp As Object, sFullname As String) As Object
    For Each p In pptApp.Presentations
        If p.FullName = sFullname Then
            Set GetPowerpointFileIfOpen = p
            Exit Function
        End If
    Next p
End Function

然后，您可以测试演示文稿是否打开，或者以其他方式打开：

Set ppt = GetPowerpointFileIfOpen(pptApp, sFullName)
If ppt Is Nothing Then
    Set ppt = pptApp.Presentations.Open(sFullName, False)
End If

---

函数PPTFileIsOpen（pptApp作为PowerPoint.Application，sFullname作为String）作为布尔值Dim x，长度为x=1，如果pptApp.Presentations（x）为pptApp.Presentations.Count.FullName=sFullname Then PPTFILEISOBEN=True退出函数End如果下一个结束函数我将pptApp更改为PowerPoint.Application我收到错误代码91-对象变量或未设置块变量。您能对此提供帮助吗？为什么将其更改为PowerPoint.Application？除非您在代码中设置了对PowerPoint的引用，并将主代码更改为将pptApp变暗为PowerPoint.Application，否则它将不起作用。这正是我所做的，它应该起作用。按原样发布代码，并指出错误所在的行。这将确定某些应用程序是否打开/锁定了文件；该应用程序可能是PowerPoint或其他应用程序（例如，启用预览窗格的Windows资源管理器、Dropbox或其他应用程序）。将这两个建议结合起来，检查这两个问题以及文件是否在PPT中打开是一个好主意。

Ret = IsWorkBookOpen("C:\Book1.xlsm")
 If Ret = True Then
    Set wb = Application.Workbooks("C:\Book1.xlsm")
    wb.Activate
Else
    Set wb = Application.Workbooks.Open("C:\Book1.xlsm")
End If

Function GetPowerpointFileIfOpen(pptApp As Object, sFullname As String) As Object
    For Each p In pptApp.Presentations
        If p.FullName = sFullname Then
            Set GetPowerpointFileIfOpen = p
            Exit Function
        End If
    Next p
End Function

Set ppt = GetPowerpointFileIfOpen(pptApp, sFullName)
If ppt Is Nothing Then
    Set ppt = pptApp.Presentations.Open(sFullName, False)
End If