View Full Version : Create a Powerpoint pps file.
Marcster
02-08-2006, 09:43 AM
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.
austenr
02-08-2006, 12:09 PM
Hey Markster,
Untested but something like this might work:
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PPSLide.Shapes.Paste.Select
PPApp.ActiveWindow.Selection.ShapeRange.Height = 400
You will no doubt have to alter the last row to suit your needs. HTH
Marcster
02-16-2006, 05:08 AM
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:
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
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.
Marcster
02-16-2006, 05:13 AM
Done it :cloud9: :
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
Now to modify so to include all non-blank worksheets :type
Marcster
02-16-2006, 06:11 AM
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.
Bob Phillips
02-16-2006, 06:43 AM
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
Marcster
02-16-2006, 07:12 AM
Thanks xld.
Is there a way to shrink the Excel data so it'll fit on the slide?.
Thanks again,
Marcster.
stanl
02-16-2006, 02:19 PM
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-
sh.Range(TheRange).Copy
.....
PP_Slide.Shapes.PasteSpecial DataType:=ppPasteOLEObject
sets in perfectly.. so thanx again... Stan
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.