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

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，我在某些表中收到此错误消息:

This Pivot Table was created in a later version of Excel and can't be updated in this version.

我在 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

这样，您就可以跟踪与切片器关联的所有数据透视表及其相应的源数据。

对于图表，最好的选择是使用形状对象。

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 仅在您的过滤器类型与值关联时使用。
如果没有，并且您过滤标签，那么它将抛出运行时。

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