关于数据透视表的报告-获取切片器、图表和过滤器信息
关于数据透视表的报告-获取切片器、图表和过滤器信息
提问于 2015-06-29 16:09:13
我正在开发一个大的报告系统，里面有大量的数据透视表，数据透视图，切片器和过滤器。
因此，为了确保所有数据透视表都有正确的源，哪些切片器适用于每个，我开始编写一个代码，为每个数据透视表聚合有用的信息：
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只在Slicer与数据透视表位于同一个工作表时才能工作。我似乎无法比在一张纸上更准确地找到它(不是戏剧性的)。
当我使用pT.Slicers(1).Parent.Name或pT.Parent.Name时，我会得到工作表的名称，但我需要SlicerCache的名称。(也许我可以在SlicerCaches上循环，而不是单，并使用这些表达式中的一个来获得工作表名)
图表
我很难使用数据透视图，因为属性HasChart已经在数据透视图对象中.我想知道是否存在，它在哪里，它是如何命名为的。为了避免中断，我想到了一个带有错误处理的函数，但我不确定这是最好的方法。
ActiveFilters和数据透视表版本
对于ActiveFilters，我得到一些表的错误消息：
此数据透视表是在更高版本的Excel中创建的，无法在此版本中更新。
我在Excel 2013中创建了几个数据透视表，通常在2010年工作，我尝试使用筛选版本，但是它们都有相同的：xlPivotTableVersion14 (value = 4)，除了给出没有任何常量来描述它的5.编辑：在Excel2013中，我发现了以下内容：Const xlPivotTableVersion15 = 5
因此，任何启示、建议或解决办法都是受欢迎的！
Stack Overflow用户
回答已采纳
发布于 2015-07-04 00:33:14
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。
如果没有，并且您过滤标签，那么它将抛出一个运行时。
对于这个版本，我认为你在检索信息方面没有问题？
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/31120497
复制相关文章
相似问题
腾讯云开发者
