Consulting

Results 1 to 5 of 5

Thread: Solved: Call SaveAs Dialog for PPT from Excel

  1. #1

    Solved: Call SaveAs Dialog for PPT from Excel

    Hi - I had this post two years ago which walked me through getting the SaveAs dialog box to show in Powerpoint. It's worked great, but now I'm stumped as how to use this when I've called Powerpoint from Excel. It only returns the Excel SaveAs.

    http://www.vbaexpress.com/forum/showthread.php?t=2946

    This is the code I'm using:
    [vba]
    Sub MakeSlide()
    Dim PPApp As Object
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    On Error Resume Next
    Set PPApp = GetObject(, "Powerpoint.Application")
    If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo ErrHandler
    Set PPApp = CreateObject("Powerpoint.Application")
    With PPApp
    .Visible = True
    .Presentations.Add
    End With
    Else
    On Error GoTo ErrHandler
    End If

    With PPApp.Presentations.Add
    .Slides.Add Index:=1, Layout:=ppLayoutTitle
    End With

    Set PPPres = PPApp.ActivePresentation
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    With PPPres.PageSetup
    .SlideSize = ppSlideSizeCustom
    .SlideWidth = 720
    .SlideHeight = 576
    .FirstSlideNumber = 1
    .SlideOrientation = msoOrientationHorizontal
    .NotesOrientation = msoOrientationVertical
    End With
    PPApp.ActiveWindow.ViewType = ppViewSlide
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    PPApp.ActiveWindow.Selection.SlideRange.Shapes.SelectAll
    PPApp.ActiveWindow.Selection.ShapeRange.Delete
    PPSlide.Shapes.Paste.Select
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    MsgBox ("Don't forget to save your new PowerPoint slide.")
    ErrHandler:
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
    On Error GoTo 0
    End Sub
    [/vba]
    Any help woudl be appreciated. Thank you!
    Last edited by SherryO; 04-20-2007 at 11:07 AM. Reason: I'm a dork and forgot the VBA tags

  2. #2
    MS Excel MVP VBAX Mentor Andy Pope's Avatar
    Joined
    May 2004
    Location
    Essex, England
    Posts
    341
    Location
    Does this work for you?

    [vba] MsgBox ("Don't forget to save your new PowerPoint slide.")

    PPApp.FileDialog(msoFileDialogSaveAs).Show
    [/vba]
    Cheers
    Andy

  3. #3
    Yes it does!! You're a peach! I don't suppose you would know how to quit Powerpoint? Neither of these is working for me. I get an activeX can't create the object...
    PPApp.Application.Quit
    PowerPoint.Application.Quit

    Thank you!

  4. #4
    MS Excel MVP VBAX Mentor Andy Pope's Avatar
    Joined
    May 2004
    Location
    Essex, England
    Posts
    341
    Location
    Try this revision to the routine.
    As only one instance of PP can be open you can just createobject. This will either use the open intance or create a new instance.
    The .Close will close the application once the PPApp is set to Nothing.

    [vba]Sub MakeSlide()
    Dim PPApp As Object
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide

    ' On Error Resume Next
    Set PPApp = CreateObject("Powerpoint.Application")
    PPApp.Visible = True
    If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo ErrHandler
    With PPApp
    .Visible = True
    ' not require as it causes 2 presentations
    '''' .Presentations.Add
    End With
    Else
    On Error GoTo ErrHandler
    End If

    With PPApp.Presentations.Add
    .Slides.Add Index:=1, Layout:=ppLayoutTitle
    End With

    Set PPPres = PPApp.ActivePresentation
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    With PPPres.PageSetup
    .SlideSize = ppSlideSizeCustom
    .SlideWidth = 720
    .SlideHeight = 576
    .FirstSlideNumber = 1
    .SlideOrientation = msoOrientationHorizontal
    .NotesOrientation = msoOrientationVertical
    End With
    PPApp.ActiveWindow.ViewType = ppViewSlide
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    PPApp.ActiveWindow.Selection.SlideRange.Shapes.SelectAll
    PPApp.ActiveWindow.Selection.ShapeRange.Delete
    PPSlide.Shapes.Paste.Select
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    MsgBox ("Don't forget to save your new PowerPoint slide.")

    PPPres.Close
    PPApp.Quit

    ErrHandler:
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
    On Error GoTo 0
    End Sub
    [/vba]
    Cheers
    Andy

  5. #5
    I cannot thank you enough. This works perfectly!!! Sherry

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •