excel - Excel:在数据透视表上打印所有过滤器
问题描述
所以,我有一个数据透视表,我将其命名为“CSRTable”,因为我没有创造力。在这个数据透视表上,它有一个销售图表,每个代表(称为 csr_name 的字段)在一组周(称为 WeekEnding 的字段)内
这是数据透视表,数据是从“Sale Raw”选项卡中提取的,它是 VBA 中的 Sheet3:
这就是我的简单数据透视表。问题是什么,我的老板给了我一个指令:打印一次,它会为给定的 WeekEnding 打印我们所有的“csr_name”。
我不熟悉如何做到这一点,我知道有一种 VBA 方法,但我还没有找到一种我能够工作的方法,这是我唯一找到的方法:
Sub LoopField()
Dim pivF As PivotField
Dim pivI As PivotItem
Set pivF = ActiveSheet.PivotTables("CSRPivot").PivotFields("csr_name")
Application.ScreenUpdating = False
For Each pivI In pivF.PivotItems
pivF.CurrentPage = pivI.Name
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next pivI
'Clear filer
pivF.ClearAllFilters
Application.ScreenUpdating = True
End Sub
但这不起作用,它只打印一个(在本例中为 Acevedo)。
因此,他想更改 CSR_NAME,而不是 WeekEnding,并将它们中的每一个打印在不同的页面上。如果 VBA 意外正确,这是它的位置,当我选择数据透视表并按 Alt+F11 时
根据我在评论中的 QHarr,
Option Explicit
'Requires all items selected
Sub GetAllCSRItems()
Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files
Dim wb As Workbook
Dim ws As Worksheet
Dim pvt As PivotTable
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2")
Set pvt = ws.PivotTables("CSRPivot")
Application.ScreenUpdating = False
Dim pvtField As PivotField
Dim item As Variant
Set pvtField = pvt.PivotFields("csr_name")
pvtField.ClearAllFilters
pvtField.CurrentPage = "(All)"
For Each item In pvtField.PivotItems
item.Visible = True
Next item
pvt.ShowPages "csr_name"
For Each item In pvtField.PivotItems
Dim newBook As Workbook
Set newBook = Workbooks.Add
With newBook
.Worksheets(1).Name = item.Name
wb.Worksheets(item.Name).UsedRange.Copy
Worksheets(item.Name).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.SaveAs Filename:=filePath & item.Name & ".xlsx"
.Close
End With
Set newBook = Nothing
Next item
Application.DisplayAlerts = False
For Each item In pvtField.PivotItems
wb.Worksheets(item.Name).Delete
Next item
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
进入
仍然从这个结果中一无所获
解决方案
我已经测试过了,您应该可以执行以下操作。
笔记:
我们正在导出包含数据透视图的工作表,因为这在 pdf 中看起来更适合大小。此外,我们还有一个额外的子程序来摆脱可以单独调用的生成的 pdf。
代码
Option Explicit
Const filePath As String = "C:\Users\User\Desktop\FolderToEmpty\"
Public Sub GetAllEmployeeSelections()
Dim wb As Workbook
Dim ws As Worksheet
Dim pvt As PivotTable
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Print THIS TAB")
Set pvt = ws.PivotTables("CSRPivot")
ws.PageSetup.Orientation = xlLandscape
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim pvtField As PivotField
Dim item As Long, item2 As Long
Set pvtField = pvt.PivotFields("csr_name")
For item = 1 To pvtField.PivotItems.Count
pvtField.PivotItems(item).Visible = True
For item2 = 1 To pvtField.PivotItems.Count
If item2 <> item Then pvtField.PivotItems(item2).Visible = False
Next item2
ws.ExportAsFixedFormat Type:=xlTypePDF, FILENAME:=filePath & Application.WorksheetFunction.Clean(Replace(pvtField.PivotItems(item).Name, ";", "_")) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next item
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Public Sub ClearFolder()
Dim f As Object, fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Left$(filePath, Len(filePath) - 1)) Then
For Each f In fso.GetFolder(Left$(filePath, Len(filePath) - 1)).Files
f.Delete Force:=True
Next f
End If
End Sub
推荐阅读
- sql - 将前导零附加到字段
- r - 在 R 中使用 RODBC 创建循环 SQL QUERY
- android - 在片段中,使用 Parcelable 实现恢复包含另一个对象列表的对象
- windows - 无法在 Windows 上使用 LLVM 库
- firebase - Firebase 安全规则从另一个节点获取值并将其与 auth.uid 进行比较
- javascript - 在 reactjs 中编辑数组
- php - Laravel 邮件事件有一个空消息
- android - 如何将提示属性转换为 ViewModel 中的观察项
- sql - 内部连接的 SQL 列单独显示?
- oracle - PLS-00103:在预期以下情况之一时遇到符号“)”:(