Question

我正在尝试创建一个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

续：

End Sub

Answer 1

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

Answer 2

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

Function PPTFileIsOpen(pptApp as object, sFullname as string) as boolean
  Dim x as long
  For x = 1 to pptApp.Presentations.Count
    if pptApp.Presentations(x).fullname = sFullname ) Then
      PPTFileIsOpen = True
      Exit Function
    end if
  Next
End Function

然后代替你：

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

使用：

If Not PPTFileIsOpen(pptApp, folderPath & file) Then
  ' open the file as you're already doing
End If

Answer 3

我已经使用此函数来确定工作簿是否已打开，它可能适用于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

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

3 个答案: