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

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.Nameor时pT.Parent.Name,我得到了工作表的名称,但我想要SlicerCache的名字.(也许我可以循环使用SlicerCaches而不是Sheets,并使用其中一个表达式来获取工作表名称)

图表

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

ActiveFilters和Pivot Table版本

对于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

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

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

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

仅当您的过滤器类型与Values关联时才使用DataField。
如果没有，并且您过滤了Labels，那么它将引发运行时。

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