CODEWITHSUNDEEP
excelvbapivot-tableslicers
MBrann
MBrann

Reputation: 265

I am looking to loop through a slicer and select the next item and the next to print a pivot

I have a slicer linked to 2 pivot tables. I want to loop through the slicer from the first item to the last item and print the corresponding tables.

I have tried the following code:

Sub Slicerloop
    Dim sI As SlicerItem, sI2 As SlicerItem, sC As SlicerCache
    Set sC = ActiveWorkbook.SlicerCaches("Slicer_UID")
    With sC
        For Each sI In sC.SlicerItems
            For Each sI2 In sC.SlicerItems
                If sI.Name = sI2.Name Then sI2.Selected = True Else: sI2.Selected = False
            Next        
        Next
    End With        
End Sub

There are no errors messages, but this does not select the next entry and thus change the pivot table.

Upvotes: 1

Views: 679

Answers (1)

Asger
Asger

Reputation: 3877

By this you can loop over all sliceritems and use their individual caption for a screenshot of your pivottable.

Private Sub LoopAllSlicerItemsAndCapturePivottable()
    Dim sc As Excel.SlicerCache
    Dim si As Excel.SlicerItem, siDummy As Excel.SlicerItem
    Dim pt As Excel.PivotTable
    Dim co As Excel.ChartObject
    Dim wsBlank As Excel.Worksheet

    Set sc = ActiveWorkbook.SlicerCaches("Slicer_UID")
    Set pt = sc.PivotTables(1)

    ' add a blank sheet to get a blank Chart instead of PivotChart later 
    Set wsBlank = ActiveWorkbook.Sheets.Add

    For Each si In sc.SlicerItems
        sc.ClearManualFilter
        For Each siDummy In sc.SlicerItems
            siDummy.Selected = (si.Name = siDummy.Name)
        Next siDummy

        ' now only 1 sliceritem is selected and can be used
        With pt.TableRange2 ' or TableRange1
            .CopyPicture Appearance:=xlScreen, Format:=xlPicture
            Set co = wsBlank.ChartObjects.Add(1, 1, .Width, .Height)
            co.Select
            co.Chart.Paste
            co.Chart.Export _
                fileName:=ActiveWorkbook.Path & "\Whatever " & si.Caption & ".png", _
                filtername:="PNG"
            co.Delete
        End With
    Next si

    Application.DisplayAlerts = False
    wsBlank.Delete
    Application.DisplayAlerts = True

End Sub

Upvotes: 1

Related Questions