Print Range - VBA

[cfatz1]

Hi-

I use the following code to set my print range at the end of my macro.
Thing is....over half the time it takes my macro to run is dedicated to
this code. It takes about 15 seconds to run the macro....and 10
seconds of it is from this code. Is there a more efficient way to code
my Print Range?

Range("A1:A3").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With

Thanks,
Chris

 

[Ron de Bruin]

Hi Chris

A faster way is to use a old Excel 4 macro
Read this from John Green

***************************************************************
PageSetup in VBA has always been a painfully slow process. If you can't avoid having
to set these parameters, you can use the Excel 4 macro function, PAGE.SETUP to carry
out most of the PageSetup operations much more quickly. The following two macros are
almost equivalent, and should give you the clues you need to start using PAGE.SETUP.
You can download a full description of all the Excel 4 macro functions from
Microsoft's web site:

Sub PS()
ActiveSheet.DisplayPageBreaks = False
With ActiveSheet.PageSetup
.LeftHeader = "My Company"
.CenterHeader = ""
.RightHeader = "&D / &T"
.LeftFooter = "Highly Confidential and Proprietary"
.CenterFooter = ""
.RightFooter = "Finance"
.LeftMargin = Application.InchesToPoints(0.54)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.36)
.HeaderMargin = Application.InchesToPoints(0.22)
.FooterMargin = Application.InchesToPoints(0.17)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600 ' does not work with all the printers
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub

Sub PS4()
head = """&LMy Company&R&D / &T"""
foot = """&LHighly Confidential and Proprietary&RFinance"""
pLeft = 0.54
pRight = 0.3
Top = 0.4
bot = 0.36
head_margin = 0.22
foot_margin = 0.17
hdng = False
grid = False
notes = False
quality = ""
h_cntr = False
v_cntr = False
orient = 2
Draft = False
paper_size = 1
pg_num = """Auto"""
pg_order = 1
bw_cells = False
pscale = True
pSetUp = "PAGE.SETUP(" & head & "," & foot & "," & pLeft & "," & pRight & ","
pSetUp = pSetUp & Top & "," & bot & "," & hdng & "," & grid & "," & h_cntr & ","
pSetUp = pSetUp & v_cntr & "," & orient & "," & paper_size & "," & pscale & ","
pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & "," & quality & ","
pSetUp = pSetUp & head_margin & "," & foot_margin & "," & notes & "," & Draft & ")"

Application.ExecuteExcel4Macro pSetUp
End Sub

John Green (Excel MVP)
Sydney
Australia