Excel to Powerpoint

[Daddylouc]

Hello,
I need some help as I'm still fairly new. I am looking for help in creating vba code that does these functions:
1. Insert a new blank slide at the end of a powerpoint file
2. Copy a range from the active excel worksheet (the range has some charts and a table)
3. Paste that range as a metafile into the newly created slide in powerpoint
4. Resize the metafile to fit the page
Note: I want to add this sub routine to a loop I've already created that refreshes the data and charts on the excel worksheet... the code needs to add a new slide to the end of the powerpoint file.

Appreciate any help!

I have been able to muster up/create this partially functioning script from several sources, but it's not doing those four steps.

Sub Powerpoint()
Dim PPPres As Object 'PowerPoint.Presentation
Dim PPSlide As Object 'PowerPoint.Slide
Dim PicCount As Long
Dim xSize As Double
Dim ySize As Double
On Error Resume Next

' CHECK TO SEE IF POWERPOINT FILE IS READY
Set PPApp = GetObject(, "PowerPoint.Application")
If PPApp Is Nothing Then ' PowerPoint is not running, notify and cancel
MsgBox "No Powerpoint session open. Please open a Powerpoint file first."
Exit Sub
End If
On Error GoTo 0

Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = 1 'ppViewSlide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
AppActivate "Microsoft Powerpoint" 'temp command
PPPres.Slides(1).Copy
PPPres.Slides.Paste (PPPres.Slides.Count + 1)


AppActivate "Microsoft Excel" 'temp command
Range("A1:V71").Select
Selection.Copy

AppActivate "Microsoft Powerpoint" 'temp command
PPSlide.Shapes.PasteSpecial DataType:=2, _
Link:=0

' Align the pasted range
PicCount = PPApp.ActiveWindow.Selection.SlideRange.Shapes.Count
With PPApp.ActiveWindow.Selection.SlideRange.Shapes(PicCount)
.Select
.LockAspectRatio = 0 'msoFalse
.Top = 12
.left = 12


xSize = 690 / .Width
ySize = 408 / .Height

If ySize <= xSize Then
'use y
.ScaleHeight ySize, 0 'msoFalse
.ScaleWidth ySize, 0 'msoFalse
Else
'use x
.ScaleHeight xSize, 0 'msoFalse
.ScaleWidth xSize, 0 'msoFalse
End If
.LockAspectRatio = -1 'msoTrue
End With
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
PPApp.ActiveWindow.ViewType = 9 'ppViewNormal
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

AppActivate "Microsoft Excel"
Beep
End Sub


- Lou

 

[Andrew Poulsom]

You don't need any AppActivates. You are already in Excel and you have created a PowerPoint application and assigned it to an object variable. If you remove those is it still not working? here is a tutorial on PowerPoint automation:

http://peltiertech.com/Excel/XL_PPT.html

 

[Daddylouc]

Thanks Andrew. I created the AppActivates as temporary commands because I wanted to see what was happening as I step through the routine. I'll remove those later.

Thanks for the link- I'll check it out