Paste Excel Chart into Powerpoint using VBA - excel

Question

I'm trying to create an excel macro that copies charts displayed on an excel sheet, and pastes them (paste special) into a PowerPoint. The problem I'm having is how do I paste each chart on a different slide? I do not know the syntax at all..
This is what I have so far (it works but it only pastes to the first sheet):
Sub graphics3()
Sheets("Chart1").Select
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.ChartArea.Copy
Sheets("Graphs").Select
range("A1").Select
ActiveSheet.Paste
With ActiveChart.Parent
.Height = 425 ' resize
.Width = 645 ' resize
.Top = 1 ' reposition
.Left = 1 ' reposition
End With
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="locationwherepptxis"
Set PPApp = GetObject("Powerpoint.Application")
Set PPPres = PPApp.activepresentation
Set PPSlide = PPPres.slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture
' Paste chart
PPSlide.Shapes.Paste.Select
' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

Answer 1

Given I dont have your file locations to work with I have attached a routine below that
Created a new instance of PowerPoint (late binding, hence the need to define constants for ppViewSlide etc)
Loops through each chart in a sheet called Chart1 (as per your example)
Adds a new slide
Pastes each chart, then repeats
Did you need to format each chart picture before exporting for size, or can you change your default chart size?
Const ppLayoutBlank = 2
Const ppViewSlide = 1
Sub ExportChartstoPowerPoint()
Dim PPApp As Object
Dim chr
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Presentations.Add
PPApp.ActiveWindow.ViewType = ppViewSlide
For Each chr In Sheets("Chart1").ChartObjects
PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
chr.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
PPApp.ActiveWindow.View.Paste
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Next chr
PPApp.Visible = True
End Sub

Answer 2

Code with function for plotting 6 charts from Excel to PPT
Option Base 1
Public ppApp As PowerPoint.Application
Sub CopyChart()
Dim wb As Workbook, ws As Worksheet
Dim oPPTPres As PowerPoint.Presentation
Dim myPPT As String
myPPT = "C:\LearnPPT\MyPresentation2.pptx"
Set ppApp = CreateObject("PowerPoint.Application")
'Set oPPTPres = ppApp.Presentations("MyPresentation2.pptx")
Set oPPTPres = ppApp.Presentations.Open(Filename:=myPPT)
ppApp.Visible = True
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
i = 1
For Each shp In ws.Shapes
strShapename = "C" & i
ws.Shapes(shp.Name).Name = strShapename
'shpArray.Add (shp)
i = i + 1
Next shp
Call Plot6Chart(oPPTPres, 2, ws.Shapes(1), ws.Shapes(2), ws.Shapes(3), ws.Shapes(4), ws.Shapes(5), ws.Shapes(6))
End Sub
Function Plot6Chart(pPres As Presentation, SlideNo As Long, ParamArray cCharts())
Dim oSh As Shape
Dim pSlide As Slide
Dim lLeft As Long, lTop As Long
Application.CutCopyMode = False
Set pSlide = pPres.Slides(SlideNo)
For i = 0 To UBound(cCharts)
cCharts(i).Copy
ppApp.ActiveWindow.View.GotoSlide SlideNo
pSlide.Shapes.Paste
Application.CutCopyMode = False
If i = 0 Then ' 1st Chart
lTop = 0
lLeft = 0
ElseIf i = 1 Then ' 2ndChart
lLeft = lLeft + 240
ElseIf i = 2 Then ' 3rd Chart
lLeft = lLeft + 240
ElseIf i = 3 Then ' 4th Chart
lTop = lTop + 270
lLeft = 0
ElseIf i = 4 Then ' 5th Chart
lLeft = lLeft + 240
ElseIf i = 5 Then ' 6th Chart
lLeft = lLeft + 240
End If
pSlide.Shapes(cCharts(i).Name).Left = lLeft
pSlide.Shapes(cCharts(i).Name).Top = lTop
Next i
Set oSh = Nothing
Set pSlide = Nothing
Set oPPTPres = Nothing
Set ppApp = Nothing
Set pPres = Nothing
End Function