数据透视表报告 - 获取切片器、图表和过滤器信息
Reports on Pivot Tables - Getting Slicers', Charts' and Filters' info
我正在开发一个包含大量数据透视表 Table、数据透视图、切片器和过滤器的大型报告系统。
因此，为了确保 所有 Pivot Table 都有正确的来源，以及哪些切片器适用于每个 ，我开始编写代码为每个 Pivot 汇总有用的信息 Table :
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
以及在切片器中获取所选项目的函数：
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 仅当切片器与枢轴 Table 在同一 sheet 上时才 有效。而且我似乎无法比在 sheet 上更准确地找到它（不是戏剧性的）。
当我使用 pT.Slicers(1).Parent.Name 或 pT.Parent.Name 时，我得到 sheet 的名称，但我想要 SlicerCache 的名称。 （也许我可以在 SlicerCaches 而不是 Sheets 上循环，并使用其中一个表达式来获取 sheet 名称）
图表
我很难使用 数据透视图 ，因为 属性 HasChart 已经在数据透视图对象中...我想知道如果有的话，它在哪里以及它是如何命名的。我想到了一个带有错误处理的函数来避免中断，但我不确定这是最好的方法。
ActiveFilters 和 Pivot Table 版本
对于 ActiveFilters，我收到一些表的错误消息：
This Pivot Table was created in a later version of Excel and can't be updated in this version.
我在 Excel 2013 年创建了几个 Pivot Table 并且通常在 2010 年工作，我尝试 过滤版本，但它们都具有相同的：xlPivotTableVersion14（值 = 4），除了给出 5 的那个没有任何常量来描述它... EDIT：在 Excel 2013 年，我发现了这个：Const xlPivotTableVersion15 = 5
因此，欢迎任何启发、建议或解决方法！
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
这样，您就可以跟踪与切片器关联的所有枢轴及其对应的源数据。
对于图表，最好的选择是使用 形状 对象。
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，那是一个集合。
要获取所有活动过滤器，您可以尝试：
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 仅在您的过滤器类型与 Values.
关联时使用
如果不是，并且您过滤 Labels，那么它会抛出一个运行时。
对于版本，我认为您在检索该信息时没有问题？
我正在开发一个包含大量数据透视表 Table、数据透视图、切片器和过滤器的大型报告系统。
因此，为了确保 所有 Pivot Table 都有正确的来源，以及哪些切片器适用于每个 ，我开始编写代码为每个 Pivot 汇总有用的信息 Table :
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
以及在切片器中获取所选项目的函数：
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 仅当切片器与枢轴 Table 在同一 sheet 上时才 有效。而且我似乎无法比在 sheet 上更准确地找到它（不是戏剧性的）。
当我使用 pT.Slicers(1).Parent.Name 或 pT.Parent.Name 时，我得到 sheet 的名称，但我想要 SlicerCache 的名称。 （也许我可以在 SlicerCaches 而不是 Sheets 上循环，并使用其中一个表达式来获取 sheet 名称）
图表
我很难使用 数据透视图 ，因为 属性 HasChart 已经在数据透视图对象中...我想知道如果有的话，它在哪里以及它是如何命名的。我想到了一个带有错误处理的函数来避免中断，但我不确定这是最好的方法。
ActiveFilters 和 Pivot Table 版本
对于 ActiveFilters，我收到一些表的错误消息：
This Pivot Table was created in a later version of Excel and can't be updated in this version.
我在 Excel 2013 年创建了几个 Pivot Table 并且通常在 2010 年工作，我尝试 过滤版本，但它们都具有相同的：xlPivotTableVersion14（值 = 4），除了给出 5 的那个没有任何常量来描述它... EDIT：在 Excel 2013 年，我发现了这个：Const xlPivotTableVersion15 = 5
因此，欢迎任何启发、建议或解决方法！
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
这样，您就可以跟踪与切片器关联的所有枢轴及其对应的源数据。
对于图表，最好的选择是使用 形状 对象。
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，那是一个集合。 要获取所有活动过滤器，您可以尝试：
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 仅在您的过滤器类型与 Values.
关联时使用
如果不是，并且您过滤 Labels，那么它会抛出一个运行时。
对于版本，我认为您在检索该信息时没有问题？