Results 1 to 8 of 8

Thread: Create a Powerpoint pps file.

  1. #1
    VBAX Mentor Marcster's Avatar
    Joined
    Jun 2005
    Posts
    434
    Location

    Create a Powerpoint pps file.

    I'm trying to create a powerpoint pps file
    via Excel VBA.

    What's the code to send each worksheet to a seperate slide?.
    The pps file will be re-created each time the macro runs.
    Thanks,

    Marcster.

  2. #2
    VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    Hey Markster,

    Untested but something like this might work:

    [VBA] Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    PPSLide.Shapes.Paste.Select
    PPApp.ActiveWindow.Selection.ShapeRange.Height = 400
    [/VBA]

    You will no doubt have to alter the last row to suit your needs. HTH
    Peace of mind is found in some of the strangest places.

  3. #3
    VBAX Mentor Marcster's Avatar
    Joined
    Jun 2005
    Posts
    434
    Location
    Tried using your code but errors.
    Error:
    Shape (unknown member) : Invalid request.
    The window must be in slide or notes view.

    So have the following code:

    [VBA]

    Sub CreatePPS()
    Dim appPP As PowerPoint.Application
    Dim PP_Presentation As PowerPoint.Presentation
    Dim PP_Slide As PowerPoint.Slide

    Set appPP = CreateObject("Powerpoint.Application")
    Set PP_Presentation = appPP.Presentations.Add
    Set PP_Slide = PP_Presentation.Slides.Add(1, ppLayoutBlank)

    Range("A1:I17").Select
    Selection.CopyPicture Appearance:=xlScreen, _
    Format:=xlPicture

    'This doesen't place in the centre of slide like I want it too :-(
    PP_Slide.Shapes.Paste.Align msoAlignCenters, msoTrue

    With PP_Presentation
    .SaveAs "C:\powerpointSlide.pps"
    .Close
    End With

    appPP.Quit

    Set PP_Slide = Nothing
    Set PP_Presentation = Nothing
    Set appPP = Nothing
    End Sub

    [/VBA]

    How can I make sure that when currrent selection in Excel
    gets pasted into Powerpoint that it centres in the middle of
    the slide?.

    Thanks,

    Marcster.

  4. #4
    VBAX Mentor Marcster's Avatar
    Joined
    Jun 2005
    Posts
    434
    Location
    Done it :

    [VBA] Sub CreatePPS()
    Dim appPP As PowerPoint.Application
    Dim PP_Presentation As PowerPoint.Presentation
    Dim PP_Slide As PowerPoint.Slide
    Set appPP = CreateObject("Powerpoint.Application")
    Set PP_Presentation = appPP.Presentations.Add
    Set PP_Slide = PP_Presentation.Slides.Add(1, ppLayoutBlank)
    Range("A1:I17").Select
    Selection.CopyPicture Appearance:=xlScreen, _
    Format:=xlPicture

    With PP_Slide.Shapes.Paste
    .Align msoAlignCenters, msoTrue
    .Align msoAlignMiddles, msoTrue
    End With

    With PP_Presentation
    .SaveAs "C:\powerpointSlide.pps"
    .Close
    End With
    appPP.Quit
    Set PP_Slide = Nothing
    Set PP_Presentation = Nothing
    Set appPP = Nothing
    End Sub
    [/VBA]

    Now to modify so to include all non-blank worksheets

  5. #5
    VBAX Mentor Marcster's Avatar
    Joined
    Jun 2005
    Posts
    434
    Location
    I would like the above CreatePPS changed to a function so I can call it
    like so:
    CreatePPS Range FileName SheetName
    So Range FileName and SheetName can be passed to CreatePPS.
    Something on the lines of:
    Function CreatePPS(ByVal TheRange As Range, ByVal FileName As String, _
    ByVal SheetName As String) As Boolean
    Maybe?.



    Also how to create a Powerpoint file with each non-blank worksheet in
    a different slide?.


    Thanks,

    Marcster.

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    [vba]
    Sub RunCreatePPS()
    CreatePPS ActiveWorkbook, "A1:I17", "C:\powerpointSlide.pps"
    End Sub

    Function CreatePPS(ByVal Book As Workbook, _
    ByVal TheRange As String, _
    ByVal FileName As String)
    Dim appPP As PowerPoint.Application
    Dim PP_Presentation As PowerPoint.Presentation
    Dim PP_Slide As PowerPoint.Slide
    Dim sh As Worksheet

    Set appPP = CreateObject("Powerpoint.Application")
    appPP.Visible = True
    Set PP_Presentation = appPP.Presentations.Add

    For Each sh In Book.Worksheets

    If Application.CountA(sh.Range(TheRange)) > 0 Then
    Set PP_Slide = PP_Presentation.Slides.Add(1, ppLayoutBlank)
    sh.Range(TheRange).CopyPicture Appearance:=xlScreen, Format:=xlPicture

    With PP_Slide.Shapes.Paste
    .Align msoAlignCenters, msoTrue
    .Align msoAlignMiddles, msoTrue
    End With

    End If

    Next sh

    With PP_Presentation
    .SaveAs FileName
    .Close
    End With

    appPP.Quit
    Set PP_Slide = Nothing
    Set PP_Presentation = Nothing
    Set appPP = Nothing
    End Function
    [/vba]

  7. #7
    VBAX Mentor Marcster's Avatar
    Joined
    Jun 2005
    Posts
    434
    Location
    Thanks xld.

    Is there a way to shrink the Excel data so it'll fit on the slide?.

    Thanks again,

    Marcster.

  8. #8
    VBAX Master stanl's Avatar
    Joined
    Jan 2005
    Posts
    1,141
    Location

    Thumbs up

    I don't mean to interrupt this thread, but it enabled me to solve a post I placed on the Powerpoint Forum. I needed to copy an Excel range that included both a picture and a table. I used the code provided by XLD with these exceptions-

    sh.Range(TheRange).Copy
    .....
    PP_Slide.Shapes.PasteSpecial DataType:=ppPasteOLEObject
    sets in perfectly.. so thanx again... Stan

Posting Permissions

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