Save to PDF multiple sheets (header, main sheet, footer)

[mike_cws]

Hello everyone! I have found a lot of help reading these forums (Google search results) and learned quite a bit. I am no expert and have an issue.

I have a workbook with several sheets that combine results into one final sheet - a purchase order. Since this sheet is dynamic and can include several rows, I created a "header" sheet and "footer" sheet. I would like to combine these now to one page as a PDF - the header, then main content sheet, then footer. So far, when I save to PDF using VBA, the header is on one page, then the main content on another page and the footer is on a 3rd page. Can they exist on one page?

Also, I wasn't sure how to set the page properties for the three sheets so I made 3 different "with" "End With" sections.

Private Sub CmdSavePdf_Click()
Sheets(Array("WINPO_HDR", "WINPO", "WINPO_FOOTER")).Select
With Worksheets("WINPO_HDR")
    .PageSetup.Orientation = xlLandscape
    .PageSetup.Zoom = False
    .PageSetup.FitToPagesTall = False
    .PageSetup.FitToPagesWide = 1
End With
With Worksheets("WINPO")
    .PageSetup.Orientation = xlLandscape
    .PageSetup.Zoom = False
    .PageSetup.FitToPagesTall = False
    .PageSetup.FitToPagesWide = 1
End With
With Worksheets("WINPO_FOOTER")
    .PageSetup.Orientation = xlLandscape
    .PageSetup.Zoom = False
    .PageSetup.FitToPagesTall = False
    .PageSetup.FitToPagesWide = 1
End With

Dim FolderPath As String
FolderPath = "C:\PDF-Tests"
' MkDir FolderPath
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FolderPath & "\WINPO_TEST", _
        openafterpublish:=False, ignoreprintareas:=False
End Sub

Thank you for your time and any help you can provide!

Mike

 

[John_w]

To get the 3 sheets onto one PDF page you have copy them all to the same (temporary) sheet.

Public Sub Create_PDF()

    Dim PDFsheet As Worksheet
    Dim destCell As Range
    
    With ThisWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
        
    Set destCell = PDFsheet.Range("A1")
    Worksheets("WINPO_HDR").UsedRange.Copy
    destCell.Select
    PDFsheet.Paste

    Set destCell = PDFsheet.Cells(PDFsheet.UsedRange.Rows.Count + 1, "A")
    Worksheets("WINPO").UsedRange.Copy
    destCell.Select
    PDFsheet.Paste
    
    Set destCell = PDFsheet.Cells(PDFsheet.UsedRange.Rows.Count + 1, "A")
    Worksheets("WINPO_FOOTER").UsedRange.Copy
    destCell.Select
    PDFsheet.Paste
    
    Application.CutCopyMode = False
    
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\PDF-Tests\WINPO_TEST.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[mike_cws]

To get the 3 sheets onto one PDF page you have copy them all to the same (temporary) sheet.

Thank you for the quick reply and possible solution. I attached this code to my command button and tried it.

The 3 sheets were saved as one pdf but the pdf was 16 pages long, mostly blank (see below). The 3 worksheets are formatted to print in landscape and the pdf appears to be portrait.

The columns on the header, _po and footer are set so they print correctly across one sheet but the pdf file is splitting them onto multiple sheets. To see what was happening, I removed the PDFsheet.Delete line and noticed the columns (A to AE) are evenly spaced.

The header sheet content is from A1 to AE4 - I tried that in the "Range" code for that line and it didn't help.
The _PO content is from A to AE and can be any number of rows. In my test, the used cells are A1 to AE6.
The footer sheet content is from A1 to AE10
Based on this example, the amount of rows in the pdf file should be 20.

The temporary sheet shows the bottom of the footer at row 182. After the header, rows 5 through 72 are blank, then starts the WIN_PO content. After the WIN_PO data, rows 79 to 172 are blank before showing the footer.

Hope the above explains a bit of what I'm seeing on this end.

1. PDF File should be in landscape mode
2. Columns break across multiple pages and are evenly spaced on the temporary sheet.
3. Blank rows between the merged worksheets.

Thank you,

Mike

 

[John_w]

This macro should be better because it also copies the column widths, looks in column A of the PDF sheet for the next destCell so blank rows in the used range of each of the 3 sheets shouldn't matter and sets the PDF sheet to landscape.

Public Sub Create_PDF2()

    Dim currentSheet As Worksheet, PDFsheet As Worksheet
    Dim destCell As Range
    Dim ws As Worksheet
    
    With ThisWorkbook
        Set currentSheet = .ActiveSheet
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
        
    Set destCell = PDFsheet.Range("A1")
    
    For Each ws In Worksheets(Array("WINPO_HDR", "WINPO", "WINPO_FOOTER"))
        ws.UsedRange.Copy
        destCell.Select
        destCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        destCell.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Set destCell = PDFsheet.Cells(PDFsheet.Rows.Count, 1).End(xlUp).Offset(1)
    Next
    
    Application.CutCopyMode = False
    
    With PDFsheet
        .PageSetup.Orientation = xlLandscape

        .ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\PDF-Tests\WINPO_TEST.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
    currentSheet.Activate
    
End Sub

 

[mike_cws]

This macro should be better because it also copies the column widths, looks in column A of the PDF sheet for the next destCell so blank rows in the used range of each of the 3 sheets shouldn't matter and sets the PDF sheet to landscape.

I had to make a minor modification because the output was splitting the pages at column 28 (AB). I ended up adding margins as well. So the section now looks like:

 With PDFsheet
        .PageSetup.Orientation = xlLandscape
        .PageSetup.LeftMargin = Application.CentimetersToPoints(1)
        .PageSetup.RightMargin = Application.CentimetersToPoints(1)
        .ResetAllPageBreaks
        .ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\PDF-Tests\WINPO_TEST2.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With

The only standing issue is that the footer rows are not holding their size (height) and I cannot find a VBA equivalent to xlPasteColumnWidths for row heights.
If any of the column widths are adjusted, widened, it will put a vertical page break again.

Thank you for your help and code. It is fairly close to 100% now. Definitely a lot further than I had originally.

 

[John_w]

The only standing issue is that the footer rows are not holding their size (height) and I cannot find a VBA equivalent to xlPasteColumnWidths for row heights.

The only way I've found to copy row heights is with the Format Painter. Replace the For Each ... Next loop with:

    For Each ws In Worksheets(Array("WINPO_HDR", "WINPO", "WINPO_FOOTER"))
        ws.UsedRange.Copy
        destCell.Select
        destCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        destCell.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ws.UsedRange.EntireRow.Copy
        With PDFsheet
            .Range(destCell, .Cells(.Rows.Count, 1).End(xlUp)).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Set destCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        End With
    Next

 

[mike_cws]

The only way I've found to copy row heights is with the Format Painter. Replace the For Each ... Next loop with:
...

Brilliant! That works.
Thank you!