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

X = WB.SlicerCaches(Slicer_Name).SlicerItems.Count

'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.

'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
        SL_Item.Selected = False
    End If
 Next SL_Item



'<< Pasting with Source Formatting >>

             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
Next Y
'Saving the Presentation
PPT_Present.SaveAs SavePath & "\" & Present_Name & ".pptx"

Set PPT_Present = Nothing
Set ActiveSlide = Nothing
'Closing the Powepoint Application Window
Set New_PowerPoint = Nothing

MsgBox "Chart for each Period is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"

End Sub

         [ BI-Reporting Analyst ]

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts