Excel:在数据透视表上打印所有过滤器

Question

所以，我有一个数据透视表，我将其命名为“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

进入



仍然从这个结果中一无所获

Answer 1

我已经测试过了，您应该可以执行以下操作。

注:

我们正在导出包含数据透视图的工作表，因为这在 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