Как зациклить в слайсере в vba

Question

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

Я перепробовал старую треску, но мой новый слайсер подключен к powerpivot

Sub Análise_Parceiro()
    'Count the time it started
    Dim StartTime As Double
    StartTime = Timer
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'Name sheets and slicers
    Dim Report_Sheet As Worksheet
    Set Report_Sheet = ThisWorkbook.Sheets("AnáliseParceiro")
    Dim Fonte_Sheet As Worksheet
    Set Fonte_Sheet = ThisWorkbook.Sheets("Análise Global Ano")
    Dim Indicadores_Sheet As Worksheet
    Set Indicadores_Sheet = ThisWorkbook.Sheets("Indicadores")

    Dim Slicer_Canal As SlicerCache
    Dim Slicer_Cadeia As SlicerCache
    Dim Slicer_Parceiro As SlicerCache
    Dim Slicer_Setor As SlicerCache

    Set Slicer_Canal = ActiveWorkbook.SlicerCaches("Slicer_Canal_de_Venda")
    Set Slicer_Cadeia = ActiveWorkbook.SlicerCaches("Slicer_Cadeia1")
    Set Slicer_Parceiro = ActiveWorkbook.SlicerCaches("Slicer_Parceiro1")
    Set Slicer_Setor = ActiveWorkbook.SlicerCaches("Slicer_Setor_de_Negócio1")

    Slicer_Canal.ClearManualFilter
    Slicer_Cadeia.ClearManualFilter
    Slicer_Parceiro.ClearManualFilter
    Slicer_Setor.ClearManualFilter

    Dim SI As SlicerItem

    If Slicer_Parceiro.SlicerItems(1).Value = "" Then
        First_Selection = Slicer_Parceiro.SlicerItems(2).Value
    Else
        First_Selection = Slicer_Parceiro.SlicerItems(1).Value
    End If


    For y = 1 To Slicer_Parceiro.SlicerItems.Count
        If Slicer_Parceiro.SlicerItems(y).Value <> First_Selection Then
            Slicer_Parceiro.SlicerItems(y).Selected = False
        End If
    Next y


    'Loop through slicers

    y = 2
    x = 1
        For Each SI In Slicer_Parceiro.SlicerItems
            Application.Calculation = xlCalculationManual

            If SI.HasData = False Then
                Exit For
            Else

                If SI.Value = "" Then
                    x = x + 1
                Else
                    SI.Selected = True


                    If x <> 1 Then
                        Slicer_Parceiro.SlicerItems(x - 1).Selected = False
                    End If

                    Application.Calculation = xlCalculationAutomatic

                    Report_Sheet.Activate
                    Report_Sheet.Cells(y, 1) = SI.Value
                    Report_Sheet.Cells(y, 2) = Indicadores_Sheet.Cells(2, 9)
                    Report_Sheet.Cells(y, 3) = Fonte_Sheet.Cells(19, 3)
                    Report_Sheet.Cells(y, 4) = Fonte_Sheet.Cells(20, 3)
                    Report_Sheet.Cells(y, 5) = Fonte_Sheet.Cells(18, 3)
                    Report_Sheet.Cells(y, 6) = Fonte_Sheet.Cells(21, 3)
                    Report_Sheet.Cells(y, 7) = Fonte_Sheet.Cells(23, 3)
                    Report_Sheet.Cells(y, 8) = Fonte_Sheet.Cells(24, 3)
                    Report_Sheet.Cells(y, 9) = Fonte_Sheet.Cells(22, 3)
                    Report_Sheet.Cells(y, 10) = Fonte_Sheet.Cells(28, 12)
                    Report_Sheet.Cells(y, 11) = Fonte_Sheet.Cells(35, 3)
                    Report_Sheet.Cells(y, 12) = Fonte_Sheet.Cells(29, 12)
                    Report_Sheet.Cells(y, 13) = Fonte_Sheet.Cells(30, 12)
                    Report_Sheet.Cells(y, 14) = Fonte_Sheet.Cells(37, 3)
                    Report_Sheet.Cells(y, 15) = Fonte_Sheet.Cells(28, 3)
                    Report_Sheet.Cells(y, 16) = Fonte_Sheet.Cells(30, 3)
                    Report_Sheet.Cells(y, 17) = Fonte_Sheet.Cells(33, 12)
                    Report_Sheet.Cells(y, 18) = Fonte_Sheet.Cells(39, 11)
                    Report_Sheet.Cells(y, 19) = Fonte_Sheet.Cells(39, 12)
                    Report_Sheet.Cells(y, 20) = Fonte_Sheet.Cells(42, 11)
                    Report_Sheet.Cells(y, 21) = Fonte_Sheet.Cells(42, 12)
                    Report_Sheet.Cells(y, 22) = Fonte_Sheet.Cells(52, 3)

                    y = y + 1
                    x = x + 1

                End If
            End If
        Next SI


    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    'Count the time it took to run
    Dim MinutesElapsed As String
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    'Notify User
    MsgBox "This code ran sucessfully in " & MinutesElapsed & " minutes", vbInformation
End Sub

Это код из обычной сводной таблицы

Теперь я получаю сообщение об ошибке: Код:

Dim SI As SlicerItem

If Slicer_Parceiro.SlicerItems(1).Value = "" Then
    First_Selection = Slicer_Parceiro.SlicerItems(2).Value
Else
    First_Selection = Slicer_Parceiro.SlicerItems(1).Value
End If

Возможно, я получу ошибку на следующих шагах.

Когда я пытался записать код VBA, когда я фильтровал срез, у меня было:

Код:

ActiveWorkbook.SlicerCaches("Slicer_parceiro1").VisibleSlicerItemsList = Array("[Query].[parceiro].&[A.C.M. POWER]")
ActiveWorkbook.SlicerCaches("Slicer_parceiro1").ClearManualFilter
ActiveWorkbook.SlicerCaches("Slicer_cadeia1").VisibleSlicerItemsList = Array("[Query].[cadeia].&[ACADEMIA]")
ActiveWorkbook.SlicerCaches("Slicer_cadeia1").ClearManualFilter
ActiveWorkbook.SlicerCaches("Slicer_Canal_de_Venda").VisibleSlicerItemsList = Array("[Query].[Canal_de_Venda].&[Motos]")
ActiveWorkbook.SlicerCaches("Slicer_Canal_de_Venda").ClearManualFilter
ActiveWorkbook.SlicerCaches("Slicer_Setor_de_Negócio1").VisibleSlicerItemsList = Array("[Query].[Setor de Negócio].&[Bicicletas e Desporto]")
ActiveWorkbook.SlicerCaches("Slicer_Setor_de_Negócio1").ClearManualFilter

Я пытался

Dim ar
Dim i As Long
ar = ActiveWorkbook.SlicerCaches("Slicer_parceiro1").VisibleSlicerItemsList
For i = LBound(ar) to UBound(ar)
    Debug.Print ar(i)
Next

и отвечалэто

[Query].[parceiro].[All]