PDF Export - Fit to page

trevolly

Board Regular
Joined
Aug 22, 2021
Messages
68
Office Version
  1. 365
Platform
  1. Windows
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
 

Attachments

  • printsetting.jpg
    printsetting.jpg
    26.7 KB · Views: 18

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,343
Is there any way I can achieve the same outcome but when the PDF exports it names itself after the excel workbooks filename?
Try:
VBA Code:
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".")) & "pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 

trevolly

Board Regular
Joined
Aug 22, 2021
Messages
68
Office Version
  1. 365
Platform
  1. Windows
Thanks @John_w, but where would I put this? Is this replacing part of the vba code I listed?
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,343
It replaces your:
VBA Code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       "C:\Users\Trevor\Desktop\Trial\Shift.pdf", Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
       False
Try it!
 
Solution

trevolly

Board Regular
Joined
Aug 22, 2021
Messages
68
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

Attachments

  • save.jpg
    save.jpg
    126.4 KB · Views: 11

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,343
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:
VBA Code:
    MsgBox "PDF file will be: " & Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".")) & "pdf"
 

trevolly

Board Regular
Joined
Aug 22, 2021
Messages
68
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Sep 5, 2004
Messages
1,932
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
If you replace the 100+ lines that you have now with this, is that what you want?
Change references where required.
Code:
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

Board Regular
Joined
Aug 22, 2021
Messages
68
Office Version
  1. 365
Platform
  1. Windows
@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

Well-known Member
Joined
Sep 5, 2004
Messages
1,932
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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
Code:
.PrintArea = Sheets(shArr(i)).UsedRange.Address
or, if you did set the print areas previously, delete that line.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,236
Messages
5,836,176
Members
430,406
Latest member
pmav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top