How to change Pivot Chart Slicer, Filter Item dynamically and and Print the Chart of each Slicer Item on Power Point Slides using Macro

Excel VBA Macro to change Pivot Chart Slicer, Filter Item dynamically and Print the Chart of each Slicer Item on Power Point Slides
Let us Suppose there is Pivot Chart with Slicer in Active Sheet as Shown below :

Now if we want to apply the Filter for each Slicer Item of Sales_Period and Generate the Charts for each Period , which means Chart for Q1-2014,Q2-2014...Q4-2014.
We can do using the following Macro.

Sub Create_PPT_Chart_Foreach_SlicerItem()
 Dim New_PowerPoint As Object
 Dim PPT_Present As PowerPoint.Presentation
 Dim ActiveSlide As PowerPoint.Slide
 Dim SL_Item As SlicerItem
 Dim WB As Object

 SavePath = ThisWorkbook.Path
 Present_Name = ThisWorkbook.Name
 Set WB = ActiveWorkbook

 Chart_Name = "Quarterly_Sales" '--This is the Chart Name
 Slicer_Name = "Slicer_Sales_Period1" '--This is the Slicer 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\Desktop\Temp\Sales_Deck.pptx")
End If
     
New_PowerPoint.Visible = True
ActiveSheet.ChartObjects(Chart_Name).Activate
    
X = WB.SlicerCaches(Slicer_Name).SlicerItems.Count
WB.SlicerCaches(Slicer_Name).ClearManualFilter

'Loop through Active Chart Slicer Filter Items applying Filter to Generate Chart and Paste into the PowerPoint Slide

For Y = 1 To X
       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
    
 Quarter = WB.SlicerCaches(Slicer_Name).SlicerItems(Y).Name
 'Looping through each Slicer Item and Checking condition to Select or Deselect
For Each SL_Item In WB.SlicerCaches(Slicer_Name).SlicerItems
    If SL_Item.Name = Quarter Then
        SL_Item.Selected = True
    Else
        SL_Item.Selected = False
    End If
 Next SL_Item

 ActiveSheet.ChartObjects(Chart_Name).Activate
    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 = 630
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Height = 450
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Top = 50    
WB.SlicerCaches(Slicer_Name).ClearManualFilter
Next Y
    
'Saving the Presentation
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 "Chart for each Period is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"
End Sub

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

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

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