@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.
