如何用VBA批量打印数据透视表各csr_name的指定WeekEnding报表？

问题梳理 #

你手上有个名为CSRPivot的数据透视表，数据源是Sheet3（"Sale Raw"工作表），目标是一次性打印每个csr_name对应的指定WeekEnding销售报表，每个销售代表的报表单独占一页。但试了两段VBA代码都没达到效果：第一段只打印了当前选中的Acevedo的报表，第二段执行后完全没反应。咱们先拆解下现有代码的问题，再给你可行的解决办法。

现有代码的问题分析 #

第一段代码的问题 #

这段代码的核心逻辑是循环切换csr_name字段的当前页然后打印，但它生效的前提是**csr_name必须是数据透视表的页字段（也就是在「筛选器」区域）**。如果你的csr_name是行/列字段，这段代码根本不会切换透视表的显示内容，自然只会打印当前选中的那一个。另外，如果有些csr_name因为WeekEnding的筛选被隐藏了，循环的时候也会跳过这些项，或者触发错误。

第二段代码的问题 #

第二段用pvt.ShowPages生成每个销售代表的工作表，但后续的循环逻辑有明显问题：你在遍历pvtField.PivotItems的时候，试图复制新生成的工作表，但wb.Worksheets(item.Name)的引用可能出错（比如生成的工作表名和PivotItem名不一致，或者还没创建），而且你之后直接删除这些工作表，可能还没来得及打印就被删掉了，所以执行后没有任何结果。

可行的解决方案 #

下面给你两个方案，根据你的透视表结构选择就行：

方案1：直接循环页字段打印（适合csr_name是筛选器的情况） #

先确认csr_name在透视表的「筛选器」区域，这段代码会循环每个有数据的销售代表，切换筛选后打印，最后恢复原来的筛选状态：

Sub PrintEachCSRReport()
    Dim pvt As PivotTable
    Dim pvtField As PivotField
    Dim pvtItem As PivotItem
    Dim originalPage As String
    
    ' 定位到你的数据透视表（Sheet2是透视表所在工作表，根据实际修改）
    Set pvt = ThisWorkbook.Worksheets("Sheet2").PivotTables("CSRPivot")
    Set pvtField = pvt.PivotFields("csr_name")
    
    ' 记录当前的筛选状态，打印完恢复
    originalPage = pvtField.CurrentPage
    
    ' 关闭屏幕刷新和警告，提升运行速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 只循环可见的销售代表（排除被WeekEnding筛选隐藏的项）
    For Each pvtItem In pvtField.PivotItems
        If pvtItem.Visible Then
            pvtField.CurrentPage = pvtItem.Name
            ' 打印当前透视表所在的工作表，每个代表单独一页
            pvt.Parent.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        End If
    Next pvtItem
    
    ' 恢复原来的筛选状态
    pvtField.CurrentPage = originalPage
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "所有报表打印完成！", vbInformation
End Sub

方案2：生成临时工作表后打印再清理（适合csr_name是行/列字段的情况） #

如果你的csr_name不是筛选器，而是行/列字段，用这个方案：先给每个销售代表生成单独的工作表，打印后再删除这些临时表：

Sub GenerateAndPrintCSRReports()
    Dim pvt As PivotTable
    Dim pvtField As PivotField
    Dim tempWs As Worksheet
    
    ' 定位到你的数据透视表
    Set pvt = ThisWorkbook.Worksheets("Sheet2").PivotTables("CSRPivot")
    Set pvtField = pvt.PivotFields("csr_name")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 给每个csr_name生成单独的工作表
    pvt.ShowPages PageField:=pvtField.Name
    
    ' 循环打印每个临时工作表，然后删除
    For Each tempWs In ThisWorkbook.Worksheets
        ' 跳过原始的透视表工作表和数据源工作表
        If tempWs.Name <> pvt.Parent.Name And tempWs.Name <> "Sale Raw" Then
            tempWs.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
            tempWs.Delete
        End If
    Next tempWs
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "所有报表打印完成！", vbInformation
End Sub

注意事项 #

• 运行代码前，先确保WeekEnding的筛选已经设置好，这样打印的就是你指定周末的数据。
• 如果有些csr_name没有对应WeekEnding的数据，方案1会自动跳过这些项，不会打印空报表。
• 运行前记得保存工作簿，避免意外情况导致数据丢失。

内容的提问来源于stack exchange，提问作者dragos_kai