我想遍历切片器,然后选择下一个项目和下一个以打印枢轴

时间:2019-07-19 11:02:38

标签: excel vba pivot-table slicers

我有一个链接到2个数据透视表的切片器。我想从第一项到最后一项遍历切片器,并打印相应的表。

我尝试了以下代码:

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

没有错误消息,但这不会选择下一个条目,因此不会更改数据透视表。

1 个答案:

答案 0 :(得分:0)

通过这种方式,您可以遍历所有切片切片,并使用它们各自的标题来显示数据透视表的屏幕截图。

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