Блог

У меня есть макрос, который печатает все сводные таблицы для каждого фильтра отчета (имя). Если я печатаю в формате 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  

С этой проблемой я столкнулся несколько лет назад, и готового решения не существует. Но это довольно просто.

В принципе, при применении каждого фильтра к сводной таблице вы создаете отдельный временный рабочий лист с копией отфильтрованной таблицы. Затем 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  

Создайте временную книгу с одним листом для каждой сводной таблицы и создайте из нее PDF-файл.

 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 gt; 1 Then  wbPDF.Sheets.Add after:=wbPDF.Sheets(n - 1)  End If  .TableRange2.Copy wbPDF.Sheets(n).Range("A1")    Else  MsgBox "Error selecting " amp; pi.Name, vbExclamation  End If  Next  End With   ' create pdf  pdfName = "AllEmployees_" amp; Format(Now, "yyyymmdd_hhmmss") amp; ".pdf"  wbPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName  wbPDF.Close False  MsgBox "PDF created " amp; pdfName, vbInformation  End Sub