Sub PowerPointが開かれていなければ開く()
On Error Resume Next 'エラーメッセージ抑制
    
    '開きたいファイルを指定、ThisWorkbook.Pathはこのファイルの場所
    パワポファイル名 = ThisWorkbook.Path & "\サンプルパワーポイント.pptx"
    
    '起動されているか確認、ここでエラーが出るので抑制
    Set パワポ起動チェック = GetObject(, "Powerpoint.Application")

    If パワポ起動チェック Is Nothing Then '開かれてなければ開く
        
        CreateObject("PowerPoint.Application").Presentations.Open (パワポファイル名)
        
    Else '開かれていれば終了
    
        MsgBox "他のパワーポイントが開いているようです閉じてから再度実行お願いします。"
        End '処理を終了
        
    End If

On Error GoTo 0 'エラーメッセージ抑制終了
End Sub