Printing Area into multiple pages with same header

user_11864751 0
Viewed 46

I have a question regarding printing an area into multiple pages, and getting the samme "area" on the top of the paper.

My problem is when i pagebreak this way, it only print out until the pagebreak, i dont get the numbers below printet out. When the second part is printet out, it needs to include the 13 first rows of the area(where the explanation is).

Hope someone can help

I have this code for printing:

Call Set_Print_Area
 
        With ActiveSheet.PageSetup
            .Orientation = xlPortrait
            .PaperSize = xlPaperA4
            .Draft = False
            .Zoom = False
            .FitToPagesTall = False
            .FitToPagesWide = 1
            .BlackAndWhite = True
            .CenterHorizontally = False
            .CenterVertically = True
ActiveSheet.HPageBreaks.Add Before:=ActiveSheet.Rows(56)
        End With

Sub Set_Print_Area()
    Dim lastCell As Long
    Dim ws As Worksheet
        
    lastCell = Range("P" & Rows.Count).End(xlUp).Offset(-4).Row
    ActiveSheet.PageSetup.PrintArea = "AB1:AS" & lastCell

    End Sub
export-to-pdf vba excel
1 Answers

Small adjustments to your code. Added the setting ..PrintTitleRows = $1:$13. Not sure why you want to break on line 56, but I guess that's your call. It did not fit exactly right when printing on A4 on my machine, but that may be a setup difference.

Option Explicit

Sub Set_Print_Area()

    Dim ws As Worksheet
    Set ws = ActiveSheet '// or whatever sheet you want to use

    Application.PrintCommunication = False

        With ws.PageSetup
            .Orientation = xlPortrait
            .PaperSize = xlPaperA4
            .Draft = False
            .Zoom = False
            .FitToPagesTall = False
            .FitToPagesWide = 1
            .BlackAndWhite = True
            .CenterHorizontally = False
            .CenterVertically = True
        
            .PrintTitleRows = "$1:$13"
            .PrintTitleColumns = ""

            '// are you sure you want to force page break on a fixed row?
            ws.HPageBreaks.Add Before:=ws.Rows(56)

        End With


    Dim lastCellOfColP As Range
    Set lastCellOfColP = ws.Range("P" & ws.Rows.Count).End(xlUp)

    Dim lastPrintedRow As Long
    lastPrintedRow = lastCellOfColP.Offset(-4).Row

    ws.PageSetup.PrintArea = "AB1:AS" & lastPrintedRow

    Application.PrintCommunication = True

End Sub
user_19927930
Related