vba 将切片器连接到 ll 数据透视表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/22047320/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Connect a slicer to ll pivot table
提问by user2244385
Status Quo:
I have an excel 2010 workbook with a worksheet named Data. All the pivot tables in the workbook draw from that sheet. I have another sheet named Boardwhere all the slicers are, and every slicer is connected to all pivot tables in the workbook.
现状：
我有一个 excel 2010 工作簿，其中包含一个名为Data的工作表。工作簿中的所有数据透视表都来自该工作表。我有另一个名为Board 的工作表，所有切片器都在其中，每个切片器都连接到工作簿中的所有数据透视表。
Need:
I have to overhaul the file quite often, adding some columns in Dataand some more pivots and slicers. Of course, pivot cache won't update automatically. Therefor new pivots can't be associated to old slicers.
需要：
我必须经常检查文件，在数据中添加一些列以及更多的枢轴和切片器。当然，枢轴缓存不会自动更新。因此，新的枢轴不能与旧的切片器相关联。
Strategy:
1_ I'd like to get a macro to detach all slicers from all pivot tables. This way if I add a new pivot I don't need to go through every slicer once again to link it.
2_ then I'd like to set all pivot caches to what I decide (Range("A1").CurrentRegion on Dataseems pretty cool, otherwise I could reserve a cell on Boardthat I update manually).
3_ third and last, attach every slicer to every pivot table in the workbook.
策略：
1_ 我想要一个宏来从所有数据透视表中分离所有切片器。这样，如果我添加一个新的枢轴，我就不需要再次通过每个切片器来链接它。
2_ 然后我想将所有枢轴缓存设置为我决定的（范围（“A1”）。数据上的当前区域看起来很酷，否则我可以在板上保留一个我手动更新的单元格）。
3_ 第三个也是最后一个，将每个切片器附加到工作簿中的每个数据透视表。
Achievements:
1_ did it for 1 slicer, guess a loop will do the trick
2_ kinda did it, but...meh
3_ no way. I can't get this done.
成就：
1_ 为 1 个切片机做到了，猜猜一个循环可以做到这一点
2_ 有点做到了，但是......嗯
3_ 没办法。我无法完成这件事。
Any suggestions?
Thank you for your help, this would be really a time saver!!
有什么建议？
谢谢你的帮助，这真的很节省时间！！
回答by user2244385
apparently I did it!!
I took some code from the internet, I forgot where.
Hope this is useful to someone!!!
显然我做到了！！
我从网上拿了一些代码，我忘记了在哪里。希望这对某人有用！！！
Sub ManageSlicers(Connect_Disconnect As String)
'feed in *connect* or *disconnect* accordingly to get it applied to all slicers in *Board*.
Dim oSlicer As Slicer
Dim oSlicercache As SlicerCache
'
Dim wks As Worksheet
Dim pt As PivotTable
For Each oSlicercache In ActiveWorkbook.SlicerCaches
For Each oSlicer In oSlicercache.Slicers
If oSlicer.Shape.BottomRightCell.Worksheet.Name = "Board" Then
For Each wks In Worksheets
For Each pt In wks.PivotTables
If Connect_Disconnect = "connect" Then
oSlicer.SlicerCache.PivotTables.AddPivotTable (Sheets(wks.Name).PivotTables(pt.Name))
ElseIf Connect_Disconnect = "disconnect" Then
oSlicer.SlicerCache.PivotTables.RemovePivotTable (Sheets(wks.Name).PivotTables(pt.Name))
Else
MsgBox "Macro ManageSlicers messed up."
End If
Next
Next
End If
Next
Next
Set oSlicer = Nothing
Set oSlicercache = Nothing
Set pt = Nothing
Set wks = Nothing
End Sub
Sub UpdatePivotCache()
'update pivottables cache
Dim wks As Worksheet
Dim pt As PivotTable
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
If lIndex = 0 Then
pt.ChangePivotCache _
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Sheets("Data").Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1))
Set ptMain = pt
lIndex = 1
Else
pt.CacheIndex = ptMain.CacheIndex
End If
Next pt
Next wks
End Sub
Sub RefreshSlicersAndPivots()
ThisWorkbook.RefreshAll
Call ManageSlicers("disconnect")
Call UpdatePivotCache
Call ManageSlicers("connect")
End Sub
