Я хочу прокрутить слайсер и выбрать следующий элемент, а затем напечатать сводную точку

У меня есть слайсер, связанный с двумя сводными таблицами. Я хочу пройти через слайсер от первого элемента к последнему и распечатать соответствующие таблицы.

Я пробовал следующий код:

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

Сообщений об ошибках нет, но это не выбирает следующую запись и, таким образом, не изменяет сводную таблицу.


excel pivot-table vba slicers
person MBrann    schedule 19.07.2019    source источник
comment
Вы можете найти ответ по следующей ссылке ниже. Не забудьте добавить .ShowAll Items или .ClearManualFilter перед вторым циклом FOR. stackoverflow.com/a/33375474/6908282   -  person Gangula    schedule 19.07.2019
comment
Ваш код почти такой же, как связанный. Он действительно выбирает каждый SlicerItem по отдельности, но вы не останавливаете свой цикл тогда (после первого Next), и поэтому он автоматически выбирает один за другим, и вы не распознаете эффект.   -  person Asger    schedule 19.07.2019
comment
Я добавил ответ с желаемой функциональностью, чтобы сохранить диапазон сводной таблицы как изображение.   -  person Asger    schedule 19.07.2019

Ответы (1)


arrow_upward
1
arrow_downward

Таким образом, вы можете перебрать все элементы срезов и использовать их отдельные подписи для снимка экрана вашей сводной таблицы.

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
person Asger    schedule 19.07.2019