问题
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