asked on

Excel VBA: properly set up page break and print view

Hello experts,

I have the following xls file.
I am looking for a procedure or a efficient way to properly set up page view breaks in order to print the various pages.
The idea will to set up a procedure in order to:
1-Read from Initial column to last column and set up page break.
2-Have the same number of rows by page.
3-Properly adjust column & height width in order to get the most the page

I want to avoid to do this manually and I suppose it should be a way of doing this through a procedure.

Thank you in advance for your help.
Data-page-set-up.xlsx

Shums Faruk

Hi LD,

Try below:

Sub SetPrintArea()
Dim Ws As Worksheet
Dim LRow As Long, LCol As Long
Dim PrintRng As Range
Set Ws = Worksheets("data")
LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row
LCol = Ws.Cells(1, Columns.Count).End(xlToLeft).Column
Set PrintRng = Ws.Range(Ws.Cells(1, 1), Ws.Cells(LRow, LCol))
Ws.PageSetup.PrintArea = PrintRng.Address

Application.ScreenUpdating = False
With Ws.PageSetup
    .PrintArea = PrintRng.Address
    .PrintTitleRows = "$1:$1"
    .CenterFooter = "Page &P of &N"
    .LeftMargin = Application.InchesToPoints(0.7)
    .RightMargin = Application.InchesToPoints(0.7)
    .TopMargin = Application.InchesToPoints(0.75)
    .BottomMargin = Application.InchesToPoints(0.75)
    .HeaderMargin = Application.InchesToPoints(0.25)
    .FooterMargin = Application.InchesToPoints(0.25)
    .PrintQuality = 600
    .CenterHorizontally = True
    .Orientation = xlLandscape
    .PaperSize = xlPaperA4
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 250
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
End With
ActiveWindow.View = xlPageLayoutView
Application.ScreenUpdating = True
End Sub

Open in new window

LD16_Data-page-set-up.xlsm

Luis Diaz

ASKER

Thank you Shums I tested and it works pretty well!
Possible to have the following adjustments?
-Define Ws = Application.Activesheet
-Add date in left header and file name in right header
-Set up narrow margin in order to get most of the page utilisation
Thank you in advance for your help.

Shums Faruk

Ok Try below:

Sub SetPrintArea()
Dim Ws As Worksheet
Dim LRow As Long, LCol As Long
Dim PrintRng As Range
Set Ws = ActiveSheet
LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row
LCol = Ws.Cells(1, Columns.Count).End(xlToLeft).Column
Set PrintRng = Ws.Range(Ws.Cells(1, 1), Ws.Cells(LRow, LCol))
PrintRng.Columns.ColumnWidth = 29
Ws.PageSetup.PrintArea = PrintRng.Address

Application.ScreenUpdating = False
With Ws.PageSetup
    .PrintArea = PrintRng.Address
    .PrintTitleRows = "$1:$1"
    .LeftHeader = Format(Date, "dd/mm/yy") 'Change the date format here
    .RightHeader = "&F"
    .CenterFooter = "Page &P of &N"
    .LeftMargin = Application.InchesToPoints(0.7)
    .RightMargin = Application.InchesToPoints(0.7)
    .TopMargin = Application.InchesToPoints(0.75)
    .BottomMargin = Application.InchesToPoints(0.75)
    .HeaderMargin = Application.InchesToPoints(0.25)
    .FooterMargin = Application.InchesToPoints(0.25)
    .PrintQuality = 600
    .CenterHorizontally = True
    .Orientation = xlLandscape
    .PaperSize = xlPaperA4
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 250
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
End With
ActiveWindow.View = xlPageLayoutView
Application.ScreenUpdating = True
End Sub

Open in new window

Luis Diaz

ASKER

Tested and it works!
Final adjustment if possible.
Msgbox "Do you want landscape orientation, please select Yes, else select No"
Thank you in advance for your help.

ASKER CERTIFIED SOLUTION

Shums Faruk

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Tested and it works! Thank you very much for your help!