ismaill
New Member
- Joined
- Apr 24, 2020
- Messages
- 4
- Office Version
- 365
- Platform
- Windows
- Web
Hello,
I prepared a macro that disconnect slicer, then change pivot source, and then reconnect slicer.
For the first time its worked as I wish, but when I reopen the excel file, the macro give error (invalid procedure call) on the below line.
Here is the macro
Can someone help me?
I prepared a macro that disconnect slicer, then change pivot source, and then reconnect slicer.
For the first time its worked as I wish, but when I reopen the excel file, the macro give error (invalid procedure call) on the below line.
VBA Code:
With ActiveWorkbook.SlicerCaches("Slicer_" & vItem).PivotTables
Here is the macro
VBA Code:
Option Explicit
Sub ChangeSourceDataForAllPivotTables_Overdues()
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_Overdues").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:="OD")
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
Can someone help me?