关于数据透视表的报告 – 获取切片器，图表和filter的信息

我正在处理大量的数据透视表，数据透视图，切片器和filter的大型报告系统。

所以为了确保所有的数据透视表都有正确的来源以及哪些切片器适用于每一个切片 ，我开始研究一个代码，为每个数据透视表汇总有用的信息：

Sub Test_2_Pt_Report_by_sheet() ThisWorkbook.Save Application.ScreenUpdating = False Dim pT As PivotTable, _ Sl As Slicer, _ RWs As Worksheet, _ Ws As Worksheet, _ pF As PivotFilter, _ pFL As PivotField, _ HeaDers As String, _ TpStr As String, _ Sp() As String, _ A() ReDim A(20, 0) Set RWs = ThisWorkbook.Sheets("PT_Report") HeaDers = "Name/Sheet/Address/Version/Source/SlicerCache/Refreshed/Slicer_Number/Slicers/Slicers_Values" & _ "ActiveFilters/Filters/ActiveValues/HasChart/Chart_Location/ / / / / / " For i = LBound(A, 1) To UBound(A, 1) A(i, 0) = Split(HeaDers, "/")(i) Next i On Error Resume Next For Each Ws In ThisWorkbook.Sheets For Each pT In Ws.PivotTables TpStr = vbNullString ReDim Preserve A(UBound(A, 1), UBound(A, 2) + 1) With pT A(0, UBound(A, 2)) = .Name A(1, UBound(A, 2)) = Ws.Name A(2, UBound(A, 2)) = Replace(.TableRange2.Address & " / " & .TableRange1.Address, "$", "") A(3, UBound(A, 2)) = .Version A(4, UBound(A, 2)) = .SourceData A(5, UBound(A, 2)) = "" '.PivotCache.Name A(6, UBound(A, 2)) = .RefreshDate A(7, UBound(A, 2)) = .Slicers.Count For Each Sl In .Slicers TpStr = TpStr & "/" & Sl.Name '& " : " & Sl.Shape.Parent.Name Next Sl If Len(TpStr) > 0 Then A(8, UBound(A, 2)) = Right(TpStr, Len(TpStr) - 1) TpStr = vbNullString Sp = Split(A(8, UBound(A, 2)), "/") For i = LBound(Sp) To UBound(Sp) TpStr = TpStr & "/" & GetSelectedSlicerItems(Sp(i)) Next i If Len(TpStr) > 0 Then A(9, UBound(A, 2)) = Right(TpStr, Len(TpStr) - 1) If .Version = xlPivotTableVersion12 Then TpStr = vbNullString For Each pF In .ActiveFilters TpStr = TpStr & "/" & pF.PivotField.Name Next pF If Len(TpStr) > 0 Then A(10, UBound(A, 2)) = Right(TpStr, Len(TpStr) - 1) Else End If TpStr = vbNullString For Each pFL In .DataFields TpStr = TpStr & "/" & pFL.Name Next pFL If Len(TpStr) > 0 Then A(11, UBound(A, 2)) = Right(TpStr, Len(TpStr) - 1) 'A(12, UBound(A, 2)) = .VisibleFields 'A(13, UBound(A, 2)) = ' A(14, UBound(A, 2)) = ' A(15, UBound(A, 2)) = ' A(16, UBound(A, 2)) = ' A(17, UBound(A, 2)) = ' A(18, UBound(A, 2)) = .PivotChart.HasChart ' A(19, UBound(A, 2)) = .PivotChart.Chart.Shapes.Name ' A(20, UBound(A, 2)) = End With Next pT Next Ws RWs.Cells.ClearContents RWs.Cells.ClearFormats RWs.Range("A1").Resize(UBound(A, 2) + 1, UBound(A, 1) + 1).Value = Application.Transpose(A) RWs.Columns("A:Z").EntireColumn.AutoFit RWs.Activate Set Ws = Nothing Set RWs = Nothing Application.ScreenUpdating = True MsgBox "done" End Sub 

以及在切片机中获取所选项目的function：

 Public Function GetSelectedSlicerItems(SlicerName As String) As String Dim oSc As SlicerCache Dim oSi As SlicerItem Dim lCt As Long Application.Volatile On Error Resume Next Set oSc = ThisWorkbook.SlicerCaches("Slicer_" & Replace(SlicerName, " ", "")) If Not oSc Is Nothing Then For Each oSi In oSc.SlicerItems If oSi.Selected Then GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Name & ", " lCt = lCt + 1 ElseIf oSi.HasData = False Then lCt = lCt + 1 End If Next If Len(GetSelectedSlicerItems) > 0 Then If lCt = oSc.SlicerItems.Count Then GetSelectedSlicerItems = "All Items" Else GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2) End If Else GetSelectedSlicerItems = "No items selected" End If Else GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found" End If End Function 

---

问题

切片机

Sl.Shape.Parent.Name只适用于切片机与透视表在同一张纸上 。 我似乎无法find它比在一张纸上更准确（而不是戏剧性）。

当我使用pT.Slicers(1).Parent.Name pT.Parent.Name或pT.Parent.Name ，我得到工作表的名称，但我想SlicerCache的名字 。 （也许我可以在SlicerCaches而不是Sheets上循环，并使用其中一个expression式来获取表名）

图表

我努力工作与枢轴图 ，因为属性HasChart已经在枢轴图对象…我想知道是否有一个，它在哪里，以及如何命名 。 我想到一个error handlingfunction，以避免中断，但我不知道这是最好的方法。

ActiveFilters和数据透视表版本

对于ActiveFilters ，我得到这个错误消息的一些表：

此数据透视表是在更高版本的Excel中创build的，无法在此版本中更新。

我在Excel 2013中创build了几个数据透视表，通常在2010年工作，我试图过滤版本，但他们都有相同的 ： xlPivotTableVersion14 （值= 4），除了一个没有任何常数来描述它… 编辑 ：在Excel 2013年，我发现这个： Const xlPivotTableVersion15 = 5

所以，欢迎任何启发，build议或解决方法！

Answer 1

在Worbook对象中有一个SlicerCaches集合。

 Dim sc As SlicerCache For Each sc In ThisWorkbook.SlicerCaches Debug.Print sc.Parent.Name ' returns the workbook name For Each pt In sc.PivotTables Debug.Print pt.Name ' returns the pivot table name Debug.Print pt.SourceData ' returns the source range Debug.Print pt.Parent.Name ' returns the sheet name Next Next 

这样，您可以跟踪与切片机及其相应源数据相关的所有关键点。

对于图表，你最好的select是使用形状对象。

 Dim sh As Shape Dim ch As ChartObject For Each sh In Sheet1.Shapes If sh.Type = msoChart Then Set ch = sh.OLEFormat.Object On Error Resume Next ' source pivot table Debug.Print ch.Chart.PivotLayout.PivotTable.Name ' location of the pivot table Debug.Print ch.Chart.PivotLayout.PivotTable.Parent.Name ' source range Debug.Print ch.Chart.PivotLayout.PivotTable.SourceData On Error GoTo 0 ' how it is named Debug.Print ch.Chart.Parent.Name ' location of the chart Debug.Print ch.Chart.Parent.Parent.Name End If Next 

当然，如果你碰巧有一个正常的图表，你需要使用OERN + OEG0。
这将导致运行时，因为没有PivotLayout与它相关联。

对于ActiveFilters ，这是一个集合。 要获得所有有效的filter，您可以尝试：

 Dim pt As PivotTable Dim pf As PivotFilter Set pt = Sheet1.PivotTables("PivotTable1") For Each pf In pt.ActiveFilters Debug.Print pf.FilterType ' returns the filter type Debug.Print pf.Value1 ' returns the value On Error Resume Next Debug.Print pf.DataField.Name ' returns the field name On Error GoTo 0 Next 

DataField仅在filtertypes与“ 值”关联时使用。
如果没有，并且你过滤了标签 ，那么它将会抛出一个运行时间。

对于该版本，我认为你没有检索这些信息的问题？