透视表报告 - 获取切片器、图表和筛选器的信息

Question

我正在开发一个包含许多数据透视表、数据透视图、切片器和筛选器的大型报告系统。

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

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仅在切片器和数据透视表位于同一工作表时才有效。我无法定位到更精确的位置（不严重）。

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

图表

我很难使用数据透视图图表，因为属性HasChart已经在数据透视图图表对象中了，我想知道是否有一个图表，它在哪里以及它的名称是什么。我考虑使用错误处理功能来避免错误，但我不确定这是否是最佳方法。

ActiveFilters 和 数据透视表版本

对于ActiveFilters，我会在一些表格中收到以下错误消息：

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

我在Excel 2013中创建了一些数据透视表，通常在2010上工作，我尝试根据版本进行过滤，但它们都是相同的： xlPivotTableVersion14 （值= 4），除了一个给出不描述它的常量5...编辑：在Excel 2013中，我发现这个：Const xlPivotTableVersion15 = 5

因此，任何启示、建议或解决方法都是受欢迎的！

- R3uK

---

一个 Slicer 有一个 SlicerCache 属性，可以直接访问所需的缓存。对于图表，我会循环遍历 ChartObjects 和 Charts 而不是 Shapes。 - Rory

Answer 1

Workbook Object 中有一个 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

通过这种方式，您可以跟踪所有与切片器及其相应源数据相关联的枢轴。

对于图表，最好使用 Shapes 对象。

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相关的过滤器类型。
如果不是与Values相关并且您过滤的是Labels，则会抛出运行时错误。

至于版本，我认为您获取该信息没有问题？

- L42

---

谢谢你的输入！我完全不知道OERN和OEG0是什么意思。 其他部分非常有用，特别是关于图表的部分，我稍后会进行评论并更新答案以反映你的有用建议。 - R3uK

@R3uK 那是 On Error Resume Next 和 On Error Goto 0。只是懒得打字而已。另外，我没有提供一个可以完全满足你需求的代码。我相信你能处理好它。如果你在尝试中遇到问题，随时可以回来这里寻求帮助。 - L42