Create a multiple pdf from a single sheet

[thomas819]

Hello,
I would like to create multiple pdf from the same sheet. Only difference will be a different selection of pivot slicer.

My idea is as follow:
After I select a new item from pivot slicer then I would like to create an first page of pdf document.
Then after I select another item from pivot slicer then I would like to create a second page of pdf document.
This process will be continue until I have 5 pages inside an pdf document.
Only then I need print out this pdf document.

Could you please help me?

 

[John_w]

See if this works for you. The sheet containing the slicer and pivot table must be the active sheet and you need change the PDFfilename and slicer name or index near the top of the code.

Public Sub Create_PDF_From_Slicer_Items()

    Dim currentSheet As Worksheet
    Dim slCache As SlicerCache
    Dim slItem As SlicerItem, slMatch As SlicerItem
    Dim PDFsheetNames As String, PDFfilename As String
    
    PDFfilename = ThisWorkbook.Path & "\All_Slicer_Items.pdf"    'Full path and file name of PDF file to be created
    
    'Set slCache = ThisWorkbook.SlicerCaches("The_Slicer_Name")  'Either: slicer's name (right-click Slicer -> Slicer Settings -> Name to use in formulas)
    Set slCache = ThisWorkbook.SlicerCaches(1)                   'Or: slicer's index number
    
    Set currentSheet = ActiveSheet
    PDFsheetNames = ""
        
    Application.ScreenUpdating = False
    
    'Loop through each slicer item
    
    For Each slItem In slCache.SlicerItems
        
        'Show all items
        
        slCache.ClearManualFilter
                        
        'Select the next slicer item to update the pivot table with that item
        
        For Each slMatch In slCache.SlicerItems
            If slItem.Name = slMatch.Name Then slMatch.Selected = True Else: slMatch.Selected = False
        Next
        
        'Create a temporary copy of the current sheet and add it to the list of sheets to be saved as a PDF
        
        With ThisWorkbook
            currentSheet.Copy After:=.Worksheets(.Worksheets.Count)
            PDFsheetNames = PDFsheetNames & "\" & .Worksheets(.Worksheets.Count).Name
        End With
        
    Next
    
    slCache.ClearManualFilter
        
    'Select all temporary sheets and save as a PDF
    
    Worksheets(Split(Mid(PDFsheetNames, 2), "\")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfilename, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    'Delete all temporary sheets
    
    Application.DisplayAlerts = False
    Worksheets(Split(Mid(PDFsheetNames, 2), "\")).Delete
    Application.DisplayAlerts = True
    
    currentSheet.Activate
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

 

[thomas819]

See if this works for you. The sheet containing the slicer and pivot table must be the active sheet and you need change the PDFfilename and slicer name or index near the top of the code.

Public Sub Create_PDF_From_Slicer_Items()

    Dim currentSheet As Worksheet
    Dim slCache As SlicerCache
    Dim slItem As SlicerItem, slMatch As SlicerItem
    Dim PDFsheetNames As String, PDFfilename As String
   
    PDFfilename = ThisWorkbook.Path & "\All_Slicer_Items.pdf"    'Full path and file name of PDF file to be created
   
    'Set slCache = ThisWorkbook.SlicerCaches("The_Slicer_Name")  'Either: slicer's name (right-click Slicer -> Slicer Settings -> Name to use in formulas)
    Set slCache = ThisWorkbook.SlicerCaches(1)                   'Or: slicer's index number
   
    Set currentSheet = ActiveSheet
    PDFsheetNames = ""
       
    Application.ScreenUpdating = False
   
    'Loop through each slicer item
   
    For Each slItem In slCache.SlicerItems
       
        'Show all items
       
        slCache.ClearManualFilter
                       
        'Select the next slicer item to update the pivot table with that item
       
        For Each slMatch In slCache.SlicerItems
            If slItem.Name = slMatch.Name Then slMatch.Selected = True Else: slMatch.Selected = False
        Next
       
        'Create a temporary copy of the current sheet and add it to the list of sheets to be saved as a PDF
       
        With ThisWorkbook
            currentSheet.Copy After:=.Worksheets(.Worksheets.Count)
            PDFsheetNames = PDFsheetNames & "\" & .Worksheets(.Worksheets.Count).Name
        End With
       
    Next
   
    slCache.ClearManualFilter
       
    'Select all temporary sheets and save as a PDF
   
    Worksheets(Split(Mid(PDFsheetNames, 2), "\")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfilename, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   
    'Delete all temporary sheets
   
    Application.DisplayAlerts = False
    Worksheets(Split(Mid(PDFsheetNames, 2), "\")).Delete
    Application.DisplayAlerts = True
   
    currentSheet.Activate
   
    Application.ScreenUpdating = True
   
    MsgBox "Done"
   
End Sub

Thank you John. You helped me a lot