Sub CreatePowerPoint()
Dim NPPT As PowerPoint.Application
Dim ASLD As PowerPoint.Slide
Dim ACTS As Worksheet
On Error Resume Next
Set NPPT = GetObject(, "PowerPoint.Application")
On Error GoTo 0
' Opening the PowerPoint application if it is not already open.
If NPPT Is Nothing Then
Set NPPT = New PowerPoint.Application
End If
' Creating a new presentation within the PowerPoint application.
NPPT.Presentations.Add
Set PPT1 = NPPT.ActivePresentation
' Adding a new slide to the new presentation.
PPT1.Slides.Add PPT1.Slides.Count + 1, ppLayoutBlank
Set ASLD = PPT1.Slides(PPT1.Slides.Count)
Set ACTS = ThisWorkbook.ActiveSheet
n = ACTS.ChartObjects.Count
' For the first chart to the last chart, copy the chart and paste to the active slide, then create a new slide and make it active.
For A = 1 To n
On Error Resume Next
ACTS.ChartObjects(A).Select
ActiveChart.ChartArea.Copy
ASLD.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
Application.CutCopyMode = False
With ALSD.Shapes(A)
.Width = 400
.Height = 250
End With
With NPPT.ActiveWindow.Selection.ShapeRange
.Left = 175
.Top = 100
End With
If A = n Then
Exit For
Else
PPT1.Slides.Add PPT1.Slides.Count + 1, ppLayoutBlank
Set ASLD = PPT1.Slides(PPT1.Slides.Count)
NPPT.ActiveWindow.ViewType = ppViewSlide
End If
Next A
End Sub