Avatar of deskchains
deskchainsFlag for United States of America

asked on 

Change/edit exported PDF name

I use(thanks to help received from EE members) the following code to export PDF from excel.  It first prompts you for a directory to save to.  It then filters through a pivot table and exports a new report for each item in the filter and names the PDF for the "filtered" item.

Function GetFolder(strPath As String) As String
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Private Sub CommandButton2_Click()

Dim pf As PivotField, pi As PivotItem

With ActiveSheet.PivotTables("Master2")
   
myFolder = GetFolder("F:\Temp\")
   
For Each pf In .PageFields 'pf is pivot field not page field
      Debug.Print pf.Name
        For Each pi In pf.PivotItems
            pf.CurrentPage = pi.Name
            'ActiveSheet.PrintOut
           
  '*********************** OLD PRINT RANGE  *****************
            ' Set rgPrint = Range("A1:P100")
'********************* New Print Range Below ************************
            Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    Set rgPrint = Range("A5:f125")
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.3)
        .RightMargin = Application.InchesToPoints(0.3)
        .TopMargin = Application.InchesToPoints(0.3)
        .BottomMargin = Application.InchesToPoints(0.3)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 2
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
   
    ' **** back to orig
    Application.PrintCommunication = True
            rgPrint.ExportAsFixedFormat Type:=xlTypePDF, IgnorePrintAreas:=False, Filename:=myFolder & "\" & Cells(6, 2).Value, Quality:=xlQualityStandard
    End With
doneprint:
       Next pi
    Next pf
 End With

End Sub


I would like to be able to add/append something with the filter item in the name.  If the pivot filter is at say 10, as it is now the PDF would be named 10.PDF.  I would like to change this so that the report is named Report10.pdf.

Suggestions.
Microsoft ExcelWindows 7

Avatar of undefined
Last Comment
deskchains
ASKER CERTIFIED SOLUTION
Avatar of deskchains
deskchains
Flag of United States of America image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Microsoft Excel
Microsoft Excel

Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.

144K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo