excel - 是否有用于将每个报表过滤器的数据透视表打印到组合 PDF 文件的宏

Question

我有一个宏，可以打印每个报告过滤器(名称)的所有数据透视表。如果我打印到 pdf，它会单独打印每个数据透视表。我想要做的是将每个数据透视表(每个过滤器选项)组合在一个 pdf 文件中。下面是我目前使用的代码。我希望有人知道如何调整 print.out 部分以将所有枢轴组合成一个 pdf

Sub PrintAll()
'
' PrintAll Macro
' Print activity table for all employees
'
Response = MsgBox("Do you want to print the overview of all employees?", vbYesNo)
If Response = vbNo Then Exit Sub
 
' always refresh the table
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
   
On Error Resume Next
Dim pf As PivotField
Dim pi As PivotItem
Set pf = ActiveSheet.PivotTables("PivotTable1").PivotFields("name")
   
  For Each pi In pf.PivotItems
   
    ActiveSheet.PivotTables("PivotTable1").PivotFields("name").CurrentPage = pi.Name
 
' now check whether the current page is indeed the desired one,
' if not, the page of that e,mployee is empty so don't print
 
    If ActiveSheet.PivotTables("PivotTable1").PivotFields("name").CurrentPage.Caption = pi.Caption Then
 
    End If
  Next
        ActiveSheet.PrintOut  'use this for printing
'    ActiveSheet.PrintPreview  'use this for testing
'
End Sub

Answer 1

这是我几年前遇到的一个问题，并且没有开箱即用的解决方案。但这相当简单。
基本上，将每个过滤器应用于数据透视表，您将创建一个 单独的和 临时 带有过滤表副本的工作表。然后Select所有这些临时工作表并将它们导出为 PDF。
下面的示例显示了 Sub创建来执行这些操作。通过创建一个单独的 Sub ，您可以根据需要为不同的数据透视表和/或不同的过滤器调用它。

Option Explicit

Sub test()
    PTtoPDF Sheet3.PivotTables(1), "name"
End Sub

Sub PTtoPDF(ByRef pt As PivotTable, ByVal fieldName As String)
    '--- access the worksheet for the given pivot table
    Dim ws As Worksheet
    Set ws = pt.Parent
    
    '--- make sure the pivot table is up to date
    pt.PivotCache.Refresh
    
    '--- filter the pivot by the given field
    Dim pf As PivotField
    Set pf = pt.PivotFields(fieldName)
    
    '--- the pivot table is filtered for each name and a copy
    '    of that filtered table creates a (separate) new
    '    (temporary) worksheet. we'll create an array to hold
    '    the worksheet names so we can create the PDF
    Dim wsNames() As Variant
    Dim wsCount As Long
    wsCount = 0
    
    '--- stop the screen from updating to go faster
    Application.ScreenUpdating = False
    
    Dim pi As PivotItem
    For Each pi In pf.PivotItems
        pf.CurrentPage = pi.Name
        
        '--- copy the filtered PT to a new sheet and save the name
        With ThisWorkbook
            wsCount = wsCount + 1
            ReDim Preserve wsNames(1 To wsCount)
            ws.Copy After:=.Sheets(ws.Name)
            Dim newWS As Worksheet
            Set newWS = .Sheets(.Sheets(ws.Name).Index + 1)
            wsNames(wsCount) = newWS.Name
        End With
    Next pi
    
    ThisWorkbook.Sheets(wsNames).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                           Filename:="sample.pdf", _
                           Quality:=xlQualityStandard, _
                           IncludeDocProperties:=True, _
                           IgnorePrintAreas:=False, _
                           OpenAfterPublish:=True
                           
    '--- finally delete the temporary sheets
    '    (disable the Alerts so that Excel doesn't ask
    '    to delete each worksheet)
    Dim previousAlertState As Boolean
    previousAlertState = Application.DisplayAlerts
    Application.DisplayAlerts = False
    
    Dim sheetName As Variant
    For Each sheetName In wsNames
        ThisWorkbook.Sheets(sheetName).Delete
    Next sheetName
    
    '--- turn it back on
    Application.DisplayAlerts = previousAlertState
    Application.ScreenUpdating = True

End Sub