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

荒凉一梦 提交于 2019-12-24 10:49:07

问题


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.


回答1:


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


来源:https://stackoverflow.com/questions/57111121/i-am-looking-to-loop-through-a-slicer-and-select-the-next-item-and-the-next-to-p

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!