How to Generate PowerPoint Slides for each Chart in Active Sheet with Excel VBA Macro

Excel VBA Macro to Generate PowerPoint Slides for each Chart in Active Sheet
Suppose In a Workbook Sheet if we have some Charts.
Now if you want the Generate the Power Point Slides for each Chart , and we can use the following Macro.
This Macro will generate the Slide for each Chart in Active Sheet and Save the Presentation in active Workbook Path with Workbook Name.
------------------------------------------------------------------------------
Sub Create_PPT_Charts_Activesheet()
 Dim New_PowerPoint As Object
 Dim PPT_Present As Powerpoint.Presentation
 Dim ActiveSlide As Powerpoint.Slide
 Dim Cht As Excel.ChartObject
     
 SavePath = ThisWorkbook.Path
 Present_Name = ThisWorkbook.Name
    
On Error Resume Next
   'Set New_PowerPoint = GetObject(, "PowerPoint.Application")
Set New_PowerPoint = CreateObject("PowerPoint.Application")

On Error GoTo 0     
If New_PowerPoint Is Nothing Then
        Set New_PowerPoint = New Powerpoint.Application
End If

If New_PowerPoint.Presentations.Count = 0 Then
        Set PPT_Present = New_PowerPoint.Presentations.Add
       'Set PPT_Present = New_PowerPoint.Presentations.Open("C:\Users\Tamatam\Downloads\Temp.pptx")
End If
     
New_PowerPoint.Visible = True
'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each Cht In ActiveSheet.ChartObjects        
New_PowerPoint.ActivePresentation.Slides.Add 
New_PowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
New_PowerPoint.ActiveWindow.View.GotoSlide 
New_PowerPoint.ActivePresentation.Slides.Count

Set ActiveSlide = New_PowerPoint.ActivePresentation.Slides                                                                                            (New_PowerPoint.ActivePresentation.Slides.Count)
'Deleting Title and Body Text boxes from PPT Slide if Not require.
 ActiveSlide.Shapes(1).Delete 'Deleting shape(1)from PPTslide
 ActiveSlide.Shapes(1).Delete 'Deleting shape(2) from PPTslide        
'Copy the chart and paste it into the PowerPoint as a Picture
 Cht.Select
 ActiveChart.ChartArea.Copy
 ActiveSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'<< Pasting with Source Formatting >>
             PPT_Slide.Select
             PPT_Slide.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Adjusting the positioning of the Chart on Powerpoint Slide
New_PowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Width = 620
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Height = 400
    
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Left = 55
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Top = 65
Next Cht

PPT_Present.SaveAs SavePath & "\" & Present_Name & ".pptx"

PPT_Present.Close
Set PPT_Present = Nothing
Set ActiveSlide = Nothing
'Closing the Powepoint Application Window
New_PowerPoint.Quit
Set New_PowerPoint = Nothing
    
MsgBox " Each Chart from Active is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"
End Sub

--------------------------------------------------------------------------------------------------------

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

--------------------------------------------------------------------------------------------------------