PDF Export - Fit to page

trevolly

Board Regular
Joined
Aug 22, 2021
Messages
64
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: 9

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,088
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
64
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,088
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
64
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: 6

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,088
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
64
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,843
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
64
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,843
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.
 

Forum statistics

Threads
1,148,259
Messages
5,745,719
Members
423,969
Latest member
seanguerrero

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