Exporting a Selection of Cells to a PDF File

[Arcinna]

So I have an excel spreadsheet and I want to be able to select for instance the row containing all the column titles and then varying selections of rows beneath that and export them all to a PDF file.

I have this code from elsewhere on this forum

Option Explicit

Sub ExportSelectionToPDF()

If TypeName(Selection) <> "Range" Then
MsgBox "Please select a range of cells, and try again!", vbExclamation, "Selection"
Exit Sub
End If

Application.PrintCommunication = False

With ActiveSheet.PageSetup
.FitToPagesTall = 1
End With

Application.PrintCommunication = True

Dim saveas_filename As Variant
saveas_filename = Application.GetSaveAsFilename( _
InitialFileName:=Application.DefaultFilePath & "\" & ActiveSheet.Name & ".pdf", _
filefilter:="PDF (*.pdf), *.pdf", _
Title:="Save As", _
ButtonText:="Save")

If saveas_filename = False Then Exit Sub


Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveas_filename

MsgBox "Completed...", vbInformation, "Completed"

End Sub

The problem I am having though is it is treating each different selection of cells as an individual page on the PDF file. It keeps putting the single row with column titles in it on one page, and the rest of the rows which i want to be on the same page as the titles on a second page. If anyone knows what needs to be done for it to treat them as a single block of data that will end up on one page in a PDF that would be very helpful.

 

[John_w]

Try this macro, which copies each selection area to contiguous rows on a temporary sheet and saves that as a PDF.

Public Sub ExportSelectionToPDF2()

    If TypeName(Selection) <> "Range" Then
        MsgBox "Please select a range of cells, and try again!", vbExclamation, "Selection"
        Exit Sub
    End If
    
    Dim saveas_filename As Variant
    saveas_filename = Application.GetSaveAsFilename( _
            InitialFileName:=Application.DefaultFilePath & "\" & ActiveSheet.Name & ".pdf", _
            filefilter:="PDF (*.pdf), *.pdf", _
            Title:="Save As", _
            ButtonText:="Save")
    If saveas_filename = False Then Exit Sub
    
    Dim PDFselection As Range
    Dim tempWs As Worksheet
    Dim r As Long
    Dim area As Range
    
    Set PDFselection = Selection
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook
        Set tempWs = ThisWorkbook.Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    
    With tempWs
        r = 1
        For Each area In PDFselection.Areas
            area.Copy .Cells(r, 1)
            r = r + area.Rows.Count
        Next
        Application.PrintCommunication = False
        .PageSetup.FitToPagesTall = 1
        Application.PrintCommunication = True
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveas_filename
    End With
    
    Application.DisplayAlerts = False
    tempWs.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    
    MsgBox "Completed...", vbInformation, "Completed"

End Sub