Is there a Macro for printing a pivot table per report filter to a combined PDF file-CodePudding

I have a Macro that prints all of the pivot tables per report filter (name). If I print to pdf it prints every pivot table individually. What I want to do is that every pivot table (per filter option) gets combined in one pdf file. Below is the code I currently work with. I was hoping that someone knew how to adjust the print.out part to combine all the pivots to one 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

CodePudding user response：

This is a problem I ran into a few years back, and there is no out-of-the-box solution. But it is fairly straightforward.

Basically, with each filter applied to the pivot table, you create a separate and temporary worksheet with a copy of the filtered table. Then Select all those temporary sheets and export them to a PDF.

The example below shows a Sub created to perform these actions. By creating a separate Sub, you can call it for different pivot tables and/or different filters as needed.

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

CodePudding user response：

Create a temporary workbook with one sheet for each pivot table and create the PDF from that.

Option Explicit
Sub PrintAll()
    '
    ' PrintAll Macro
    ' Print activity table for all employees
    '
    Dim response
    response = MsgBox("Do you want to print the overview of all employees?", vbYesNo)
    If response = vbNo Then Exit Sub
       
    Dim pt As PivotTable, pf As PivotField, pi As PivotItem
    Dim wbPDF As Workbook, n As Integer, pdfName As String

    ' create temporary workbook
    Set wbPDF = Workbooks.Add(1)

    Set pt = ActiveSheet.PivotTables("PivotTable1")
    With pt
        .PivotCache.Refresh ' always refresh the table
        Set pf = .PivotFields("name")
        For Each pi In pf.PivotItems
            .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 .PivotFields("name").CurrentPage.Caption = pi.Caption Then
                n = n   1
                If n > 1 Then
                    wbPDF.Sheets.Add after:=wbPDF.Sheets(n - 1)
                End If
                .TableRange2.Copy wbPDF.Sheets(n).Range("A1")
               
            Else
                MsgBox "Error selecting " & pi.Name, vbExclamation
            End If
        Next
    End With

    ' create pdf
    pdfName = "AllEmployees_" & Format(Now, "yyyymmdd_hhmmss") & ".pdf"
    wbPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName
    wbPDF.Close False
    MsgBox "PDF created " & pdfName, vbInformation

End Sub