Option Explicit
Public Sub RunThePowerpointTour()
Const szAppName As String = "PowerPoint Window Tour"
Const szShowName As String = "TestpptShow.ppt"
Const ppShowTypeInWindow = 1000
Dim oPPTApp As Object
Dim oPPTPres As Object
Dim szShowPath As String
szShowPath = FixTrailingSeparator(ThisWorkbook.Path)
Dim szValidShowPath As String
szValidShowPath = szShowPath & szShowName
On Error Resume Next
Set oPPTApp = CreateObject("PowerPoint.Application")
If Not oPPTApp Is Nothing Then
Set oPPTPres = oPPTApp.Presentations.Open(szValidShowPath, , , False)
If Not oPPTPres Is Nothing Then
With oPPTPres
With .SlideShowSettings
.ShowType = ppShowTypeInWindow
.Run
End With
End With
Else
MsgBox "Presentation could not be found", 16, szAppName
End If
Else
MsgBox "Powerpoint could not be found", 16, szAppName
End If
Set oPPTApp = Nothing
Set oPPTPres = Nothing
End Sub
Public Function FixTrailingSeparator(Path As String, _
Optional PathSeparator As String = "\") As String
Select Case Right(Path, 1)
Case PathSeparator
FixTrailingSeparator = Path
Case Else
FixTrailingSeparator = Path & PathSeparator
End Select
End Function
|