VBA Script to Print Selected Content in Excel

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.