VBA Script to Print Selected Content in Excel

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.