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.

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

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.

Done it :cloud9: :

[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 :type

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.

[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]

Thanks xld.

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

Thanks again,

Marcster.

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:thumb with these exceptions-

Code:

---

sh.Range(TheRange).Copy
.....
PP_Slide.Shapes.PasteSpecial DataType:=ppPasteOLEObject

---

sets in perfectly.. so thanx again... Stan