Open PPT presentation, go back to Excel without closing PPT

brh

New Member
Joined
Nov 10, 2005
Messages
6
I need to push a button in Excel, have it prompt the user to with the Open dialog box in PowerPoint. If the user clicks "Cancel" I want it to go back to Excel, but not close PowerPoint. Here's the code I have so far:

Code:
Sub Open_A_Presentation()

Dim Master As Variant
Const ppWindowMaximized As Integer = 3
Dim PPTApp As Object
Dim fd As FileDialog
Dim CountItemSelected As Variant
Dim Open_Name As Variant

Master = ActiveWorkbook.Name

Set PPTApp = CreateObject("PowerPoint.Application")

With PPTApp
    .Visible = True
    .WindowState = ppWindowMaximized
    .Activate
End With

Set fd = PPTApp.FileDialog(msoFileDialogOpen)
With fd
    .FilterIndex = 2
    .AllowMultiSelect = False
    .InitialFileName = "D:\"
    .Show
End With

CountItemSelected = fd.SelectedItems.Count
If CountItemSelected = 0 Then
    ********WHAT DO I PUT HERE??*********
*******I've tried the following, but none of them work!********
    'Windows(Master).Visible = True
    'Windows(Master).Activate
    'ActiveWindow.WindowState = xlMaximized
    'ActiveWindow.Application.Workbooks(Master).Activate
    'Application.Workbooks(Master).Activate
    
    MsgBox "Action Cancelled", , "Open PowerPoint Presentation"
    Exit Sub
End If
    
Open_Name = fd.SelectedItems.Item(1)

PPTApp.Presentations.Open Open_Name

PPTApp.ActivePresentation.Slides(1).Select

With PPTApp.ActivePresentation.SlideShowSettings
    .ShowType = ppShowTypeSpeaker
    .AdvanceMode = ppSlideShowManualAdvance
    .Run
End With

Set fd = Nothing

End Sub

Any ideas??[/code]
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Couldn't you just check PPTApp.Windows.Count and if zero close, else set excel back up and then exit sub?
 
Upvote 0
Meant to mention this too: unless ppShowTypeSpeaker and ppSlideShowManualAdvance are zeroes, won't those constants be undefined at compile time since you're using late binding?
 
Upvote 0
But, if windows.count is not zero, what would the code look like that takes me back to Excel? ie. Makes Excel my active window? I can't get it to work.

What did you mean by 'late binding'? I use VBA in Excel all the time, but I'm a newbie at this whole Powerpoint VBA thing. I got the ppShowTypeSpeaker and ppSlideShowManualAdvance by recording a macro in ppt.
Any suggestions on how to make sure I don't get a compile error?

Thanks a bunch!
 
Upvote 0
I figured it out!

Code:
Sub Sample()

Dim Master As Variant
Const ppWindowMaximized As Integer = 3
Const ppWindowMinimized As Integer = 2
Const ppShowTypeSpeaker As Integer = 0
Const ppSlideShowManualAdvance As Integer = 0
Dim PPTApp As Object
Dim fd As FileDialog
Dim CountItemSelected As Variant
Dim Open_Name As Variant

Master = ActiveWorkbook.Name

On Error Resume Next
'- try to get PPT application
    Set PPTApp = GetObject(, "PowerPoint.Application")
    If Err.Number Then ' ppt is not open
        Set PPTApp = CreateObject("PowerPoint.Application")
    End If
    On Error GoTo 0

With PPTApp
    .Visible = True
    .WindowState = ppWindowMaximized
    .Activate
End With

Set fd = PPTApp.FileDialog(msoFileDialogOpen)
With fd
    .FilterIndex = 2
    .AllowMultiSelect = False
    .InitialFileName = "D:\"
    .Show
End With

CountItemSelected = fd.SelectedItems.Count
If CountItemSelected = 0 Then
    If PPTApp.Windows.Count = 0 Then
        PPTApp.Quit
    Else
        PPTApp.WindowState = ppWindowMinimized
    End If
    AppActivate Master
    Windows(Master).Visible = True
    MsgBox "Action Cancelled", , "Open PowerPoint Presentation"
    Exit Sub
End If
    
Open_Name = fd.SelectedItems.Item(1)

PPTApp.Presentations.Open Open_Name

PPTApp.ActivePresentation.Slides(1).Select

With PPTApp.ActivePresentation.SlideShowSettings
    .ShowType = ppShowTypeSpeaker
    .AdvanceMode = ppSlideShowManualAdvance
    .Run
End With

Set fd = Nothing
Set PPTApp = Nothing

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top