How to copy and paste charts from Excel into placeholders in PowerPoint? - excel

Question

I have 2 charts on each sheets in a workbook and I would like to copy 2 to each slide's placeholders. The code now keeps creating a new PowerPoint instead of using the template I have opened. I have the following code.
Sub CopyPasteCharts()
MsgBox "Select the file you have generated.", vbInformation + vbOKOnly
Dim fNameAndPath As Variant, wb As Workbook
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set wb = Workbooks.Open(fNameAndPath)
wb.Activate
Dim ppt As PowerPoint.Application
Dim ppTPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
Dim pptCL As PowerPoint.CustomLayout
Dim pptShp As PowerPoint.Shape
Dim chtt As Chart
Dim ws As Worksheet
Dim i As Long
'Optimise execution of code
Application.ScreenUpdating = False
'Get the PowerPoint Application object:
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = msoTrue
'Set ppTPres = ppt.Presentations.Add
'Get a Custom Layout:
For Each pptCL In ppTPres.SlideMaster.CustomLayouts
If pptCL.Name = "Title and Content" Then Exit For
Next pptCL
'Copy ALL charts embedded in EACH WorkSheet:
For Each ws In ActiveWorkbook.Worksheets
Set pptSld = ppTPres.Slides.AddSlide(ppTPres.Slides.Count + 1, pptCL)
pptSld.Select
For i = 1 To ws.ChartObjects.Count
For Each pptShp In pptSld.Shapes.Placeholders
If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
Next pptShp
Set chtt = ws.ChartObjects(i).Chart
chtt.ChartArea.Copy
ppt.Activate
pptShp.Select
ppt.Windows(1).View.Paste
Next i
Next ws
'Optimise execution of code
Set chtt = Nothing
Set pptSld = Nothing
Application.ScreenUpdating = True
'Clear clipboard
Application.CutCopyMode = False
End Sub
this is how my placeholders look like
[EDIT]
I have changed the code but there. A subscript out of range happens at ActiveWorkbook.Worksheets("Chart 1").ChartObjects(1).Activate.ChartArea.Copy
New code:
'To get the file
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set wb = Workbooks.Open(fNameAndPath)
wb.Activate
Dim obPptApp As PowerPoint.Application
Dim OpenPptDialogBox As Object
Dim MyChart As Chart
Dim MyShape As Object
Set obPptApp = CreateObject("PowerPoint.Application")
Set OpenPptDialogBox = obPptApp.FileDialog(msoFileDialogOpen)
'Open the target PPT using dialog box
If OpenPptDialogBox.Show = -1 Then
obPptApp.Presentations.Open (OpenPptDialogBox.SelectedItems(1))
End If
'Copy the chart from excel macro file
ActiveWorkbook.Worksheets("Chart 1").ChartObjects(1).Activate.ChartArea.Copy
'Paste the chart in slide 1 of PPT
Set MyShape = obPptApp.ActiveWindow.Presentation.Slides(1).Shapes.Paste