Sub PushChartsToPPT()
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 cht As Chart
Dim ws As Worksheet
Dim i As Long
Dim strPptTemplatePath As String
strPptTemplatePath = ""File path""
Set ppt = CreateObject(""PowerPoint.Application"")
ppt.Visible = msoTrue
Set pptPres = ppt.Presentations.Open(strPptTemplatePath, untitled:=msoTrue)
For Each pptCL In pptPres.SlideMaster.CustomLayouts
If pptCL.Name = ""Title and Content"" Then Exit For
Next pptCL
For Each cht In ActiveWorkbook.Charts
Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)
pptSld.Select
For Each pptShp In pptSld.Shapes.Placeholders
If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
Next pptShp
If pptShp Is Nothing Then Stop
cht.ChartArea.Copy
ppt.Activate
pptShp.Select
ppt.Windows(1).View.Paste
Next cht
For Each ws In ActiveWorkbook.Worksheets
For i = 1 To ws.ChartObjects.Count
Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)
pptSld.Select
For Each pptShp In pptSld.Shapes.Placeholders
If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then
If pptShp.Left = 50 Then Exit For
End If
Next pptShp
For Each pptShp In pptSld.Shapes.Placeholders
If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
Next pptShp
Set cht = ws.ChartObjects(i).Chart
cht.ChartArea.Copy
ppt.Activate
pptShp.Select
ppt.Windows(1).View.Paste
Next i
Next ws
End Sub
