VBA Script to Print Selected Content in Excel

Platinum Contributor

Jun 12, 2023

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

lj4028aim

Copper Contributor

Jun 12, 2023

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.

NikolinoDE

Platinum Contributor

Jun 13, 2023

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.

Forum Discussion

VBA Script to Print Selected Content in Excel

Resources