Macro with multiple Headers for multiple pages

A

amkkhan

Board Regular
Joined
Dec 11, 2021
Messages
75
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Here is the link to file. I the last sheet "Individual Result GT"
I want to get a macro that Generates a pdf or print with following properties
1) Row 1 to Row 7 header for all first 10 pages (7 Rows header)
a) out of very first these 10 pages I want only pages to be printed/converted to pdf that contain data (ignore Blank pages)
b) each page contains 5 Records (Information)
c) You can view Print Preview to view details
2) Row 259 to 266 (8 Rows Header) for page 11 and 12
3) No header for last/13th page

Print Tiles option in Excel is not helping me unfortunately :(
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
amkkhan said:
Here is the link to file. I the last sheet "Individual Result GT"
I want to get a macro that Generates a pdf or print with following properties
1) Row 1 to Row 7 header for all first 10 pages (7 Rows header)
a) out of very first these 10 pages I want only pages to be printed/converted to pdf that contain data (ignore Blank pages)
b) each page contains 5 Records (Information)
c) You can view Print Preview to view details
2) Row 259 to 266 (8 Rows Header) for page 11 and 12
3) No header for last/13th page

Print Tiles option in Excel is not helping me unfortunately :(
Click to expand...
@HaHoBe .... @John_w

May be you would like to check this one
 
Upvote 0
Hi amkkhan,

on both systems I worked on the code I ran into trouble getting continuous page numbers for the printout so I introduced a boolean to show up the PageSetup Dialog for control as on my systems I did neither get the running number nor the total number of pages but the name of the workbook or the path to the workbook instead.

Basicly the macro copies over the wanted sheet (for 3 different setups), changes formulas to values, deletes rows to get the area to work on, setup the sheet, setup title rows, the printarea, get the number of pages printed up to then,. After having seletced the sheets you will get the dialog for control and after closing that dialog the PDF should be created and the copied sheets deleted.

VBA Code: 
Sub MrE1223268()
'https://www.mrexcel.com/board/threads/macro-with-multiple-headers-for-multiple-pages.1223268/
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
PDFsheets = PDFsheets & ActiveSheet.Name & ","
With ws
  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:$T$" & .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
PDFsheets = PDFsheets & ActiveSheet.Name & ","
With ws
  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
  .Rows("56:257").Delete
  .PageSetup.PrintArea = ""
  .HPageBreaks(2).DragOff Direction:=xlDown, RegionIndex:=1
  Application.PrintCommunication = False
  With .PageSetup
    .PrintTitleRows = "$1:$9"
    .PrintTitleColumns = ""
  End With
  Application.PrintCommunication = True
  .PageSetup.PrintArea = "$A$1:$T$" & .Cells(258, "H").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
PDFsheets = PDFsheets & ActiveSheet.Name & ","
With ws
  With .UsedRange
    .Value = .Value
  End With
  .Rows("1:331").Delete
  .PageSetup.PrintArea = ""
  .PageSetup.PrintArea = "$A$1:$T$" & .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:=False

With Application
  .DisplayAlerts = False
  ActiveWindow.SelectedSheets.Delete
  .DisplayAlerts = True
  .ScreenUpdating = True
End With

MsgBox "Created 'C:\result\Result-" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & ".pdf'."

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 : ________________________________"
  .LeftMargin = Application.InchesToPoints(0.236220472440945)
  .RightMargin = Application.InchesToPoints(0.236220472440945)
  .TopMargin = Application.InchesToPoints(0.236220472440945)
  .BottomMargin = Application.InchesToPoints(0.62992125984252)
  .HeaderMargin = Application.InchesToPoints(0.31496062992126)
  .FooterMargin = Application.InchesToPoints(0.31496062992126)
  .PrintQuality = 600
  .CenterHorizontally = True
  .CenterVertically = True
  .Orientation = xlLandscape
  .Draft = False
  .PaperSize = xlPaperA4
  .FirstPageNumber = lngPrint
  .Zoom = 41
End With
End Sub

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi amkkhan,

on both systems I worked on the code I ran into trouble getting continuous page numbers for the printout so I introduced a boolean to show up the PageSetup Dialog for control as on my systems I did neither get the running number nor the total number of pages but the name of the workbook or the path to the workbook instead.

Basicly the macro copies over the wanted sheet (for 3 different setups), changes formulas to values, deletes rows to get the area to work on, setup the sheet, setup title rows, the printarea, get the number of pages printed up to then,. After having seletced the sheets you will get the dialog for control and after closing that dialog the PDF should be created and the copied sheets deleted.

VBA Code: 
Sub MrE1223268()
'https://www.mrexcel.com/board/threads/macro-with-multiple-headers-for-multiple-pages.1223268/
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
PDFsheets = PDFsheets & ActiveSheet.Name & ","
With ws
  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:$T$" & .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
PDFsheets = PDFsheets & ActiveSheet.Name & ","
With ws
  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
  .Rows("56:257").Delete
  .PageSetup.PrintArea = ""
  .HPageBreaks(2).DragOff Direction:=xlDown, RegionIndex:=1
  Application.PrintCommunication = False
  With .PageSetup
    .PrintTitleRows = "$1:$9"
    .PrintTitleColumns = ""
  End With
  Application.PrintCommunication = True
  .PageSetup.PrintArea = "$A$1:$T$" & .Cells(258, "H").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
PDFsheets = PDFsheets & ActiveSheet.Name & ","
With ws
  With .UsedRange
    .Value = .Value
  End With
  .Rows("1:331").Delete
  .PageSetup.PrintArea = ""
  .PageSetup.PrintArea = "$A$1:$T$" & .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:=False

With Application
  .DisplayAlerts = False
  ActiveWindow.SelectedSheets.Delete
  .DisplayAlerts = True
  .ScreenUpdating = True
End With

MsgBox "Created 'C:\result\Result-" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & ".pdf'."

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 : ________________________________"
  .LeftMargin = Application.InchesToPoints(0.236220472440945)
  .RightMargin = Application.InchesToPoints(0.236220472440945)
  .TopMargin = Application.InchesToPoints(0.236220472440945)
  .BottomMargin = Application.InchesToPoints(0.62992125984252)
  .HeaderMargin = Application.InchesToPoints(0.31496062992126)
  .FooterMargin = Application.InchesToPoints(0.31496062992126)
  .PrintQuality = 600
  .CenterHorizontally = True
  .CenterVertically = True
  .Orientation = xlLandscape
  .Draft = False
  .PaperSize = xlPaperA4
  .FirstPageNumber = lngPrint
  .Zoom = 41
End With
End Sub

Ciao,
Holger
Click to expand...
I am getting Error on line 9.
is it possible for you to share on OneDrive please
 

Attachments

  • Error-1.jpg
    Error-1.jpg
    15.4 KB · Views: 17
  • Screenshot (4).png
    Screenshot (4).png
    103.8 KB · Views: 19
Upvote 0
Hi amkkhan,

this error shows that you use a different file than the one you uploaded while I can only work with the uploaded one.

Change the codeline
VBA Code: 
  .HPageBreaks(2).DragOff Direction:=xlDown, RegionIndex:=1
to
VBA Code: 
  .ResetAllPageBreaks

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi amkkhan,

this error shows that you use a different file than the one you uploaded while I can only work with the uploaded one.

Change the codeline
VBA Code: 
  .HPageBreaks(2).DragOff Direction:=xlDown, RegionIndex:=1
to
VBA Code: 
  .ResetAllPageBreaks

Ciao,
Holger
Click to expand...
Thanks, it worked but printed only up to column T. Although I have data up to Column AF in my other files.
secondly it is also publishing stats (that are not required) see below

Stats-1.jpg

and this one

Stats-2.jpg

The page Orientation should be Horizontal in the entire document.
and it should now display dialog box before publishing and not even display msg rather it should display/open the published file when it's done.
 
Upvote 0
Hi amakkhan,

don't you think it would be a good idea to create a sample that resembles your live data and adjust the print settings to what you want before uploading instead of claiming things after a code was supplied? And a real surplus would have been if you had attached a sample sheet that looks like the result you want.

Holger
 
Upvote 0
Hi amkkhan,

VBA Code: 
Sub MrE1223268_mod()
'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 ranges 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
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
PDFsheets = PDFsheets & .Name & ","
With ws
  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
PDFsheets = PDFsheets & .Name & ","
With ws
  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
  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
PDFsheets = PDFsheets & .Name & ","
With ws
  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 = xlPortrait
  .Draft = False
  .PaperSize = xlPaperA4
  .FirstPageNumber = lngPrint
  '/// squeezing data to fit on one page
  .Zoom = False
  .FitToPagesWide = 1
  .FitToPagesTall = False
End With
End Sub
Holger
 
Last edited:
Upvote 0
HaHoBe said:
Hi amkkhan,

VBA Code: 
Sub MrE1223268_mod()
'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 ranges 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
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
PDFsheets = PDFsheets & .Name & ","
With ws
  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
PDFsheets = PDFsheets & .Name & ","
With ws
  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
  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
PDFsheets = PDFsheets & .Name & ","
With ws
  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 = xlPortrait
  .Draft = False
  .PaperSize = xlPaperA4
  .FirstPageNumber = lngPrint
  '/// squeezing data to fit on one page
  .Zoom = False
  .FitToPagesWide = 1
  .FitToPagesTall = False
End With
End Sub
Holger
Click to expand...
Error.jpg
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
420
Aurum1
A
D
  • Question Question
Print Multiple invoices in one PDF File
Replies
1
Views
258
John_w
J
D
  • Question Question
VBA Multiple "conditional" page breaks
Replies
3
Views
1K
Domenic
D
A
  • Question Question
Print Tiles for Limited Pages
Replies
1
Views
412
John_w
J
T
  • Question Question
How to add cell value in certain row in every print page's header
Replies
3
Views
510
tyruschen
T

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top