关于数据透视表的报告 - 获取切片器、图表和过滤器的信息

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 而不是 Sheets 上循环，并使用这些表达式之一来获取工作表名称）

图表

我很难使用 数据透视图，因为属性 HasChart 已经在数据透视图对象中...我想知道 是否有一个，它在哪里以及它是如何命名的。我想到了一个带有错误处理的函数来避免中断，但我不确定这是最好的方法。

ActiveFilters 和数据透视表版本

对于ActiveFilters，我收到一些表的错误消息：

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

我在 Excel 2013 中创建了几个数据透视表，通常在 2010 年工作，我尝试使用版本进行过滤，但它们都具有相同的：xlPivotTableVersion14（值 = 4），除了一个给出 5 没有任何常数来描述它... 编辑：在 Excel 2013 上，我发现了这个：Const xlPivotTableVersion15 = 5

因此，欢迎任何启发、建议或解决方法！

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

这样，您可以跟踪与切片器关联的所有枢轴及其对应的源数据。

对于图表，最好的选择是使用 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 相关联时使用。
如果没有，并且您过滤 Labels，那么它将抛出运行时。

对于该版本，我认为您在检索该信息时没有问题？