PDF Export - Fit to page

[trevolly]

Hi All,

I'm wondering if anyone can help with vba code for exporting selected sheets to a PDF format from a open workbook. I have made a daily log for work and it is titled the date and then day / night (for ex 13/09/21 Day or 13/09/21 Night) and then this workbook contains four worksheets (named Duty Team, Daily Log Report, Closures & Handover) I would need to export to a PDF format which would also have the same file name as the corresponding workbook.

I would like the PDF export to use the print settings "Landscape orientation" and "Fit All Columns on One Page" so that each of these worksheets fits on one PDF page in width. I have recorded a macro which does this and it works but the only caveat is that the macro recording wants a filename (at the moment set to "Shift"). Is there any way I can achieve the same outcome but when the PDF exports it names itself after the excel workbooks filename? Im more than happy for the PDF export to save in the same folder as the original excel file.

Many thanks all.
T

The macro has produced the vba coding of...

Sub PDFExport()
'
' PDFExport Macro
'

'
Sheets(Array("Duty Team", "Daily Log Report", "Closures", "Handover")).Select
Sheets("Duty Team").Activate
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.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 = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.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 = ""
End With
Application.PrintCommunication = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Trevor\Desktop\Trial\Shift.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub

 

[John_w]

Is there any way I can achieve the same outcome but when the PDF exports it names itself after the excel workbooks filename?

Try:

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".")) & "pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

 

[trevolly]

Thanks @John_w, but where would I put this? Is this replacing part of the vba code I listed?

 

[John_w]

It replaces your:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       "C:\Users\Trevor\Desktop\Trial\Shift.pdf", Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
       False

Try it!

 

[trevolly]

Thanks but it does the same as the original code - it opens a box to type a save name. I was wondering if it could auto capture the excel workbook name - in this case "12-10-21 Day" and auto export to PDF

 

[John_w]

I don't really see how the original code and the modified code would bring up a folder browser/file save dialogue, and your screenshot doesn't look like a standard Excel 'Save As' dialogue. Have you got any event-handling code in the ThisWorkbook or sheet modules or an add-in which is displaying that dialogue?

My modified code is designed to capture the workbook name with ".pdf" replacing whatever the workbook's file extension is, and saved in the same folder as the workbook. Add this line at the start of the PDFExport macro to verify the PDF's full file name:

    MsgBox "PDF file will be: " & Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".")) & "pdf"

 

[trevolly]

Tried it on another version of the workbook and it works, thank you. It looks really professional compared to what my department is doing atm. Thank you

 

[jolivanes]

If you replace the 100+ lines that you have now with this, is that what you want?
Change references where required.

Sub How_About_So()
Dim shArr, i As Long, fn As String
Application.ScreenUpdating = False
fn = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
shArr = Array("Duty Team", "Daily Log Report", "Closures", "Handover")
    For i = LBound(shArr) To UBound(shArr)
        With Sheets(shArr(i)).PageSetup
            .PrintArea = Sheets(shArr(i)).Cells(1, 1).CurrentRegion.Address
            .Zoom = False
            .Orientation = xlLandscape
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    Next i
Sheets(shArr).Copy
    ActiveWorkbook.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & fn & ".pdf"
    ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub

 

[trevolly]

@jolivanes - When you run the macro it comes up with "You've selected a single cell for the print area, If correct click ok" If you click ok it makes you click ok several times then it produces a PDF but there is only one line of content, If you cancel a runtime error appears.

 

[jolivanes]

Change the reference for your print area.
You have empty cells below/beside the top left cell by the looks of it.
However, from here I can't see what your sheets look like and you haven't mentioned it neither.
You can try

.PrintArea = Sheets(shArr(i)).UsedRange.Address

or, if you did set the print areas previously, delete that line.