Thursday, 11 September 2014

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

Excel VBA Macro to change Pivot Chart Slicer Filter Item dynamically and 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.

This job we can done 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
         [ BI-Reporting Analyst ]

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts