Отключить слайсер, изменить точку поворота, повторно подключить слайсер - PullRequest
0 голосов
/ 27 апреля 2020

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

Я подготовил макрос ниже

Option Explicit

Sub ChangeSourceDataForAllPivotTables_All()

   Dim PT                          As PivotTable
   Dim ptMain                      As PivotTable
   Dim WS                          As Worksheet
   Dim oDic                        As Object
   Dim oPivots                     As Object
   Dim i                           As Long
   Dim lIndex                      As Long
   Dim Max                         As Long
   Dim vPivots
   Dim vSlicers
   Dim vItem


   vSlicers = Array("Exp._Closing_Date_Year", "IB_Segment", "Project_Status", "Project_Movement_Flag", "Region", "Company_Country", "Employee_Responsible")
   Set oDic = CreateObject("Scripting.Dictionary")

   Max = Sheets("DATA_All").Cells(Rows.Count, "A").End(xlUp).Row

   ' disconnect slicers
   For Each vItem In vSlicers
      With ActiveWorkbook.SlicerCaches("Slicer_" & vItem).PivotTables
         If .Count > 0 Then
            Set oPivots = CreateObject("Scripting.Dictionary")
            For i = .Count To 1 Step -1
               oPivots.Add .Item(i).Name, .Item(i)
               .RemovePivotTable .Item(i)
            Next i
            oDic.Add vItem, oPivots
         End If
      End With
   Next vItem

   ' update pivottables
   For Each WS In ActiveWorkbook.Worksheets
      For Each PT In WS.PivotTables
         If lIndex = 0 Then
            PT.ChangePivotCache _
                  ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                                    SourceData:="ALL")
            Set ptMain = PT
            lIndex = 1
         Else
            PT.CacheIndex = ptMain.CacheIndex
         End If
      Next PT
   Next WS

   ' reconnect slicers
   For Each vItem In vSlicers
      If oDic.Exists(vItem) Then
         Set oPivots = oDic(vItem)
         vPivots = oPivots.Items
         For i = LBound(vPivots) To UBound(vPivots)
            ActiveWorkbook.SlicerCaches("Slicer_" & vItem).PivotTables.AddPivotTable vPivots(i)
         Next i
      End If
   Next vItem

   Set oDic = Nothing

Dim MySheet As Worksheet
Dim MyPivot As PivotTable
Dim slCaches As SlicerCaches
Dim slCache As SlicerCache

Set slCaches = ThisWorkbook.SlicerCaches

For Each slCache In slCaches
    For Each MySheet In ActiveWorkbook.Worksheets
        For Each MyPivot In MySheet.PivotTables
            slCache.PivotTables.AddPivotTable MyPivot
        Next MyPivot
    Next MySheet
Next slCache

End Sub

Тем не менее, я получил Неверную ошибку вызова процедуры в строке ниже.

      With ActiveWorkbook.SlicerCaches("Slicer_" & vItem).PivotTables

Надеюсь, кто-то может мне помочь, потому что я уже потратил более четырех часов на эту проблему.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...