Excel Charts to Powerpoint Paste Special

Sub CreateGraphicOnSlide()

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppShape As PowerPoint.Shape
Dim ppCurrentSlide As PowerPoint.Slide
Dim r As Range, sh As Worksheet

'choose which range you want to use
Set r = ActiveSheet.Range("A1:O18")
'Set r = ActiveSheet.Range("A1:N30")

Worksheets.Add After:=Worksheets(Worksheets.Count)
Set sh = Worksheets(Worksheets.Count)
r.Parent.Activate
r.Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
sh.Pictures.Paste
sh.Shapes(1).Copy

Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = True

Set ppPres = ppApp.Presentations.Add(msoTrue)
Set ppCurrentSlide = ppPres.Slides.Add(Index:=1, Layout:=ppLayoutBlank)


With ppCurrentSlide
ppCurrentSlide.Shapes.Paste
Set ppShp = ppCurrentSlide.Shapes(1)
ppShp.Top = 50
ppShp.Left = 40

' use the following if necessary

' ppShp.width = ??
' ppShp.height = ??


End With

' Save the presentation and quit Microsoft PowerPoint.
'ppPres.SaveAs "c:\My Documents\pptExample2", ppSaveAsPresentation
'ppApp.Quit
Set ppApp = Nothing
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End Sub

Click to expand...