VBA Script to Print Selected Content in Excel

Copper Contributor

Good morning all,

 

I am currently set up a VBA script to print out user selected area and save it in pdf format. However, I am always having bugs in the if statement. What I am expecting the script does is detecting if user selected area beyond one page. If it does, I want all selected contents adjust their scale/size automatically and print onto one page; it it doesn't, all contents shall be output and fit onto one page as well. I tried a while debugging but still couldn't find out the best solution. Hoping some people could help on this. BTW, I really don't care about how big or small the contents will be, one requirement is the output paper size shall be always as 11.0x8.5 (letter). Thanks for your time and support in advance.
==================================================================

Sub PrintWorkbookToPDF()
' Store the current selection range
Dim selectedRange As Range
Set selectedRange = Selection

' Set print settings
With ActiveSheet.PageSetup
.PaperSize = xlPaperLetter ' Set paper size to 8.5x11 inches
.PrintQuality = 2400 ' Set print quality to 2400 dpi
.CenterHorizontally = True ' Center horizontally on page
.CenterVertically = True ' Center vertically on page
.LeftHeader = "" ' Set header to blank
.RightHeader = "" ' Remove right header
.LeftFooter = "" ' Remove left footer
.RightFooter = "" ' Remove right footer
.Orientation = xlLandscape ' Set orientation to landscape

' Set margin settings to normal
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)

' Set the print area to the selected range
.PrintArea = selectedRange.Address

' Check if the selected range fits on one page
If selectedRange.Height <= .PageSetup.PaperHeight And selectedRange.Width <= .PageSetup.PaperWidth Then
' If the selected range fits on one page, use the default settings
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
Else
' If the selected range doesn't fit on one page, adjust the content's scale to fit on one page
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False ' Remove this line to let the content scale vertically as necessary
End If
End With

' Prompt the user to select the folder and enter the file name
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select Folder to Save PDF"
If .Show = -1 Then
' Get the selected folder path
folderPath = .SelectedItems(1)

' Prompt the user to enter the file name
Filename = InputBox("Enter the File Name", "Save PDF")

' Save the workbook as PDF
filePath = folderPath & "\" & Filename & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard
MsgBox "PDF file saved successfully."
Else
MsgBox "No folder selected. PDF file not saved."
End If
End With
End Sub

16 Replies

@lj4028aim 

The VBA script you provided seems to have the basic structure in place. However, there are a few modifications maybe you can make to achieve the desired functionality of adjusting the content's scale to fit on one page if it exceeds the page boundaries.

Here is an updated version of the script:

Sub PrintWorkbookToPDF()
    ' Store the current selection range
    Dim selectedRange As Range
    Set selectedRange = Selection
    
    ' Set print settings
    With ActiveSheet.PageSetup
        .PaperSize = xlPaperLetter ' Set paper size to 8.5x11 inches
        .PrintQuality = 2400 ' Set print quality to 2400 dpi
        .CenterHorizontally = True ' Center horizontally on page
        .CenterVertically = True ' Center vertically on page
        .LeftHeader = "" ' Set header to blank
        .RightHeader = "" ' Remove right header
        .LeftFooter = "" ' Remove left footer
        .RightFooter = "" ' Remove right footer
        .Orientation = xlLandscape ' Set orientation to landscape
        
        ' Set margin settings to normal
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        
        ' Set the print area to the selected range
        .PrintArea = selectedRange.Address
        
        ' Calculate the number of pages required to fit the selected range
        Dim totalPages As Long
        totalPages = WorksheetFunction.Ceiling(selectedRange.Height / .PageSetup.PaperHeight, 1)
        
        ' Check if the selected range fits on one page
        If totalPages <= 1 And selectedRange.Width <= .PageSetup.PaperWidth Then
            ' If the selected range fits on one page, use the default settings
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        Else
            ' If the selected range doesn't fit on one page, adjust the content's scale to fit on one page
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False ' Remove this line to let the content scale vertically as necessary
            .Zoom = .PageSetup.PaperWidth / selectedRange.Width
        End If
    End With
    
    ' Prompt the user to select the folder and enter the file name
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder to Save PDF"
        If .Show = -1 Then
            ' Get the selected folder path
            folderPath = .SelectedItems(1)
            
            ' Prompt the user to enter the file name
            Filename = InputBox("Enter the File Name", "Save PDF")
            
            ' Save the workbook as PDF
            filePath = folderPath & "\" & Filename & ".pdf"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard
            MsgBox "PDF file saved successfully."
        Else
            MsgBox "No folder selected. PDF file not saved."
        End If
    End With
End Sub

In this updated version of the script, the key modification is calculating the totalPages required to fit the selected range. If the totalPages is greater than 1, it means that the selected range cannot fit on a single page. In such cases, the content's scale is adjusted to fit horizontally on one page by setting .Zoom = .PageSetup.PaperWidth / selectedRange.Width. This ensures that the content is scaled proportionally to fit within the page boundaries horizontally.

By adjusting the zoom level, the content will be scaled down to fit within the width of the page, and the height will adjust accordingly to maintain the aspect ratio. This helps in fitting the selected range onto a single page when it exceeds the page boundaries.

Once the necessary adjustments are made, the script proceeds with saving the workbook as a PDF file.

Please note that the script assumes the default printer settings and page setup for the active sheet. If you have specific print settings, such as different paper sizes or margins, you may need to modify the script accordingly.

I hope this clarifies the explanation and this info and code helps you.

@NikolinoDE
I really appreciate your insights and help here. I give it a try and having such error: "Run-time error '438'" Object doesn't support this property or method". When I run debugging mode, it shows the bug is existing at line "totalPages = WorksheetFunction.Ceiling(selectedRange.Height / .PageSetup.PaperHeight, 1)". It seems the excel I was using didn't have such property or method. When I run my script before, I believe I had the same error message existed at line "' Check if the selected range fits on one page
If selectedRange.Height <= .PageSetup.PaperHeight And selectedRange.Width <= .PageSetup.PaperWidth Then".
I believe it is necessary to mention the version of Excel I am currently running on my computer. The version is Microsoft 365. I am not sure there is a similar property or method has same functionality in this specific version of Excel. Thanks.

@lj4028aim 

For Excel for Microsoft 365, you can try using the PageSetup property of the Worksheet object instead. Here is an updated version of the script that should work with Excel for Microsoft 365:

Sub PrintWorkbookToPDF()
    ' Store the current selection range
    Dim selectedRange As Range
    Set selectedRange = Selection
    
    ' Set print settings
    With ActiveSheet.PageSetup
        .PaperSize = xlPaperLetter ' Set paper size to 8.5x11 inches
        .PrintQuality = 2400 ' Set print quality to 2400 dpi
        .CenterHorizontally = True ' Center horizontally on page
        .CenterVertically = True ' Center vertically on page
        .LeftHeader = "" ' Set header to blank
        .RightHeader = "" ' Remove right header
        .LeftFooter = "" ' Remove left footer
        .RightFooter = "" ' Remove right footer
        .Orientation = xlLandscape ' Set orientation to landscape
        
        ' Set margin settings to normal
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        
        ' Set the print area to the selected range
        .PrintArea = selectedRange.Address
        
        ' Calculate the number of pages required to fit the selected range
        Dim totalPages As Long
        totalPages = WorksheetFunction.Ceiling(selectedRange.Height / ActiveSheet.PageSetup.PaperHeight, 1)
        
        ' Check if the selected range fits on one page
        If totalPages <= 1 And selectedRange.Width <= ActiveSheet.PageSetup.PaperWidth Then
            ' If the selected range fits on one page, use the default settings
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        Else
            ' If the selected range doesn't fit on one page, adjust the content's scale to fit on one page
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False ' Remove this line to let the content scale vertically as necessary
            .Zoom = ActiveSheet.PageSetup.PaperWidth / selectedRange.Width
        End If
    End With
    
    ' Prompt the user to select the folder and enter the file name
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder to Save PDF"
        If .Show = -1 Then
            ' Get the selected folder path
            folderPath = .SelectedItems(1)
            
            ' Prompt the user to enter the file name
            Filename = InputBox("Enter the File Name", "Save PDF")
            
            ' Save the workbook as PDF
            filePath = folderPath & "\" & Filename & ".pdf"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard
            MsgBox "PDF file saved successfully."
        Else
            MsgBox "No folder selected. PDF file not saved."
        End If
    End With
End Sub

Please give this updated script a try.

The updated script should work in most versions of Excel, including Excel for Microsoft 365. However, please note that Excel for Microsoft 365 may have different versions or updates across different users, which could potentially result in slight variations in behavior.

@NikolinoDE
Thanks for your reply. It's kind of interesting, same error message occurs at line of code "totalPages = WorksheetFunction.Ceiling(selectedRange.Height / ActiveSheet.PageSetup.PaperHeight, 1)". It seems the version of excel doesn't support this method or function. I am wondering there is an approach to bypass this. Thanks.

@lj4028aim 

Replace the following line of code:

vba code

totalPages = WorksheetFunction.Ceiling(selectedRange.Height / ActiveSheet.PageSetup.PaperHeight, 1) 

 

With this updated calculation:

vba code

totalPages = Application.Ceiling(selectedRange.Height / ActiveSheet.PageSetup.PaperHeight, 1)

 

By using the Application.Ceiling method instead of WorksheetFunction.Ceiling, you can perform the same rounding up operation to calculate the number of pages needed.

 

@NikolinoDE 

lj4028aim_0-1686584937472.png

Same error occurs at line of code "totalPages = Application.Ceiling(selectedRange.Height / ActiveSheet.pageSetup.PaperHeight, 1)". Not sure what else we can do to solve the compatibility issue. Really irritated....

@lj4028aim 

If possible, please insert the file (without sensitive data).
Additional information such as Excel version, operating system, storage medium (hard drive, OneDrive, Sharepoint, USB, etc.) would be beneficial.
 
Thank you for your patience and understanding

@NikolinoDE 

 

Sorry, couldn't load the origin file, but here is the screen shot to represent the file. The selected range means from cell A1 to B37, but the range is really depending on the user's selection which means it will be a dynamic range. The version of Excel if Microsoft 365 (Enterprise) and OS is Windows 10 (10.0.19045) Enterprise. Physical memory is 16G. Hopefully this helps for debugging. Thanks.

lj4028aim_0-1686591819022.png

 

@lj4028aim 

The setup of the print settings and margin settings are correct.

Here is an example of how you can modify if statement to check if the selected range fits on one page:

 

Sub PrintWorkbookToPDF()
' Store the current selection range
Dim selectedRange As Range
Set selectedRange = Selection

' Set print settings
With ActiveSheet.PageSetup
    .PaperSize = xlPaperLetter ' Set paper size to 8.5x11 inches
    .PrintQuality = 2400 ' Set print quality to 2400 dpi
    .CenterHorizontally = True ' Center horizontally on page
    .CenterVertically = True ' Center vertically on page
    .LeftHeader = "" ' Set header to blank
    .RightHeader = "" ' Remove right header
    .LeftFooter = "" ' Remove left footer
    .RightFooter = "" ' Remove right footer
    .Orientation = xlLandscape ' Set orientation to landscape

    ' Set margin settings to normal
    .TopMargin = Application.InchesToPoints(0.75)
    .BottomMargin = Application.InchesToPoints(0.75)
    .LeftMargin = Application.InchesToPoints(0.75)
    .RightMargin = Application.InchesToPoints(0.75)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)

    ' Set the print area to the selected range
    .PrintArea = selectedRange.Address

    ' Check if the selected range fits on one page
    Dim printableHeight As Double
    Dim printableWidth As Double
    printableHeight = .PaperHeight - .TopMargin - .BottomMargin
    printableWidth = .PaperWidth - .LeftMargin - .RightMargin

    If selectedRange.Height <= printableHeight And selectedRange.Width <= printableWidth Then
        ' If the selected range fits on one page, use the default settings
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    Else
        ' If the selected range doesn't fit on one page, adjust the content's scale to fit on one page
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False ' Remove this line to let the content scale vertically as necessary
    End If
End With

' Prompt the user to select the folder and enter the file name
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder to Save PDF"
    If .Show = -1 Then
        ' Get the selected folder path
        folderPath = .SelectedItems(1)

        ' Prompt the user to enter the file name
        Filename = InputBox("Enter the File Name", "Save PDF")

        ' Save the workbook as PDF
        filePath = folderPath & "\" & Filename & ".pdf"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard
        MsgBox "PDF file saved successfully."
    Else
        MsgBox "No folder selected. PDF file not saved."
    End If
End With

End Sub

 

I hope that works, otherwise I am at my wits end.

NikolinoDE

I really appreciate your help and time. Unfortunately, the same error occurs again at line of code "printableHeight = .PaperHeight - .TopMargin - .BottomMargin". I might need to dive deeper into Microsoft manual for VBA to resolve this issue. Again, thanks.

According to the official documentation, Excel PageSetup doesn't have the properties PaperHeight and PaperWidth; they are listed as properties for the Printer object in Publisher and for the Document object in Visio, and there is a PageHeight property for the PageSetup object in Word and Publisher, but that's it. Apparently there is no way to know what are the sizes of the page in Excel, only if it is custom or one of the standard presets; I've found people asking this exact question on StackOverflow since 2009...

@Beregorn 

Thanks for the insights. It seems a problem being around for a while. BTW, did anyone in StackOverflow posted any updated answer for it?

@lj4028aim In the Page Setup UI dialog box, "Scaling" is an option between "Adjust to" and "Fit to", meaning it's one or the other. If you select "Adjust to" 100% normal size, for example, the "Fit to" settings are ignored. If you select "Fit to" 1 page wide by 1 tall, the zoom percentage is adjusted automatically.

 

In VBA, to use the "Adjust to" option, simply set the Zoom property to a numeric value for the desired percentage. For example:

 

'Adjust to: 100% normal size
    With ActiveSheet.PageSetup
        .PrintArea = Selection.Address
        .Zoom = 100
    End With

 

To use the "Fit to" option, first set the Zoom property to False, then set the FitToPagesWide and FitToPagesTall properties as desired. For example:

 

'Fit to: 1 page wide by 1 tall
    With ActiveSheet.PageSetup
        .PrintArea = Selection.Address
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

 

When using the "Fit to" option, there is no need to calculate the zoom percentage... as soon as you print, print preview or save as PDF, the zoom percentage will automatically adjust for the print area to fit on one page.

 

I hope that helps clear things up. Cheers!

Much appreciated! I will give it a shot and give it back to you!
Sadly, I have found only a little more than the equivalent of "sucks to be you": the "best" suggestion is to manually build a case selector where you read the name of the standard and associate to it their actual measurements. If the format is "custom", you are screwed.
For our particular case, since we set the page size using the PageSetup, you don't really have to read the page size, since you already know it: you just have to replace the .PaperWidth call with the actual number.
Or use the function FitToPage___ = 1 instead of the zoom.
It seems it could be a good example giving to AI or Copilot to resolve in the near future.