Sub MrE1223268_mod03()
'https://www.mrexcel.com/board/threads/macro-with-multiple-headers-for-multiple-pages.1223268/
'change of range for printout from A:T to A:AF
'changing from Landscape to Portrait
'excluding a range from the printout
'excluding Header and Footer from scaling for the printout
'showing PDF after creation, no MsgBox shown
'no information about data for the first sheets so this is only a guess of how manual pagebreaks are set
'
'swapping of codelines to include a command into the With-clause
'
'change from xlPortrait to xlLandscape in proc amkkhanPageSetup
'printing for second sheet has been altered: if up to 25 items one page,
' number of items between 26 and 30 manual pagebreak to have 20 and rest on follow-up,
' pagebreak at row 34 (25 + 9 for header) for full first page and rest on follow-up
Dim lngPrint As Long
Dim rngLast As Range
Dim PDFsheets As String
Dim ws As Worksheet
Const cstrShData As String = "Individual Result GT"
Const cblnAlterSheetNumbers As Boolean = True
PDFsheets = ""
lngPrint = 1
Sheets(cstrShData).Copy After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
'/// start swapping codelines
With ws
PDFsheets = PDFsheets & .Name & ","
'/// end swapping codelines
With .UsedRange
.Value = .Value
End With
Set rngLast = .Cells(258, "F").End(xlUp).Offset(1, 0)
.Rows(rngLast.Row & ":" & .Rows.Count).Delete
Application.PrintCommunication = False
With .PageSetup
.PrintTitleRows = "$1:$7"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
.PageSetup.PrintArea = "$A$1:$AF$" & .Cells(258, "F").End(xlUp).Row
Application.PrintCommunication = False
amkkhanPageSetup ws, cstrShData, lngPrint
Application.PrintCommunication = True
Set rngLast = Nothing
End With
lngPrint = lngPrint + ExecuteExcel4Macro("Get.document(50)")
Set ws = Nothing
Sheets(cstrShData).Copy After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
'/// start swapping codelines
With ws
PDFsheets = PDFsheets & .Name & ","
'/// end swapping codelines
With .UsedRange
.Value = .Value
End With
Set rngLast = .Cells(331, "B").End(xlUp).Offset(1, 0)
.Rows(rngLast.Row & ":316").Delete
.Rows("1:257").Delete
Set rngLast = .Cells(58, "B").End(xlUp).Offset(1, 0)
.Rows(rngLast.Row & ":257").Delete
.PageSetup.PrintArea = ""
.ResetAllPageBreaks
Application.PrintCommunication = False
With .PageSetup
.PrintTitleRows = "$1:$9"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
.PageSetup.PrintArea = "$A$1:$AF$" & .Cells(258, "H").End(xlUp).Row
'/// add a manual pagebreak if needed to acoid single records on follow-up page
Select Case .Cells(258, "H").End(xlUp).Row
Case Is <= 25
'nothing to do, fits fine
Case 26 To 30
'/// printing 20 items on first page, rest on follow-up
.HPageBreaks.Add Before:=.Range("A30")
Case Is > 30
.HPageBreaks.Add Before:=.Range("A35")
End Select
Application.PrintCommunication = False
amkkhanPageSetup ws, cstrShData, lngPrint
Application.PrintCommunication = True
Set rngLast = Nothing
End With
lngPrint = lngPrint + ExecuteExcel4Macro("Get.document(50)")
Set ws = Nothing
Sheets(cstrShData).Copy After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
'/// start swapping codelines
With ws
PDFsheets = PDFsheets & .Name & ","
'/// end swapping codelines
With .UsedRange
.Value = .Value
End With
.Rows("1:331").Delete
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = "$A$1:$AF$" & .Cells(258, "H").End(xlUp).Row
Application.PrintCommunication = False
amkkhanPageSetup ws, cstrShData, lngPrint
Application.PrintCommunication = True
Set rngLast = Nothing
End With
Set ws = Nothing
Worksheets(Split(Left(PDFsheets, Len(PDFsheets) - 1), ",")).Select
If cblnAlterSheetNumbers Then Application.Dialogs(xlDialogPageSetup).Show
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\result\Result-" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
With Application
.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Sub amkkhanPageSetup(ws As Worksheet, _
cstrShData As String, _
lngPrint As Long)
With ws.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftHeader = cstrShData
.CenterHeader = " "
.RightHeader = "&P"
.LeftFooter = "Class Incharge : ________________________________"
.CenterFooter = "Controller of Exam : ________________________________"
.RightFooter = "Principal : ________________________________"
'/// left margin augmented
.LeftMargin = Application.InchesToPoints(0.62992125984252)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.236220472440945)
'/// bottom margin augmented
.BottomMargin = Application.InchesToPoints(0.62992125984252)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintQuality = 600
'/// Header and Footer will be printed in normal size
.ScaleWithDocHeaderFooter = False
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = lngPrint
'/// squeezing data to fit on one page
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
End Sub
