Use VBA to set worksheet formatting

[Rick_Stanich]

I started this macro from macro recorder but it takes a very long time.
Is there something to do to speed it up?

Sub PrintFormat()
' Macro recorded 11/29/2010 by 35
'
    Sheets(1).Activate
    With Sheets(1).PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Sheets(1).PageSetup.PrintArea = ""
    With Sheets(1).PageSetup
        .RightHeader = "&Pof &N"
        .LeftFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintQuality = 600
        .CenterHorizontally = True
        .Orientation = xlPortrait
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    Sheets(2).Activate
    With Sheets(2).PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Sheets(2).PageSetup.PrintArea = ""
    With Sheets(2).PageSetup
        .LeftHeader = ""
        .RightHeader = "&Pof &N"
        .LeftFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintQuality = 600
        .CenterHorizontally = True
        .Orientation = xlPortrait
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    Sheets(3).Activate
    With Sheets(3).PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Sheets(3).PageSetup.PrintArea = ""
    With Sheets(3).PageSetup
        .RightHeader = "&Pof &N"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .Zoom = 85
    End With
    
Sheets(1).Activate
End Sub

Any hints, tips or examples are appreciated.

[watersev]

try this way:

Sub PrintFormat()
For Each sh In ThisWorkbook.Sheets
    With sh.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .PrintArea = ""
        .RightHeader = "&Pof &N"
        .LeftFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintQuality = 600
        .CenterHorizontally = True
        .Orientation = xlPortrait
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
Next
Sheets(1).Activate: End Sub

Some parameters are as you would like to have as default value so no need to change - the way to speed it up

[solnajeff]

Hi

This has been a pain for some time, however you can speed it up using the Excel 4 macro function.

Here are a couple of links explaining how to go about it.

http://www.mcgimpsey.com/excel/udfs/pagesetup.html
http://www.pcreview.co.uk/forums/thread-947330.php

Regards

Jeff

[TMS]

Configuring the Printer settings was always very slow, in my experience ... and you're going through the process three times. It also used to depend on the printer driver, though it's a while since I've tried this so it might have improved

If all the pages are (roughly) the same, try grouping the sheets and recording the macro as you set the parameters once for all the pages. Having recorded the macro, edit it to remove any default settings

Regards

[romperstomper]

PageSetup (before XL2010) is notoriously slow due to the communication between VBA and the printer drivers. You should either try to format the sheets ahead of time (e.g. use a template sheet) or use the old XLM PAGE.SETUP method:

  Public Sub PageSetupXL4M(Optional LeftHead As String, Optional CenterHead As String, Optional RightHead As String, _
        Optional LeftFoot As String, Optional CenterFoot As String, Optional RightFoot As String, _
        Optional LeftMarginInches As String, Optional RightMarginInches As String, Optional TopMarginInches As String, _
        Optional BottomMarginInches As String, Optional HeaderMarginInches As String, Optional FooterMarginInches As String, _
        Optional PrintHeadings As String, Optional PrintGridlines As String, Optional PrintComments As String, _
        Optional PrintQuality As String, Optional CenterHorizontally As String, Optional CenterVertically As String, _
        Optional Orientation As String, Optional Draft As String, Optional PaperSize As String, _
        Optional FirstPageNumber As String, Optional Order As String, Optional BlackAndWhite As String, _
        Optional Zoom As String)
     'based on a post by John Green in
     'microsoft.public.excel.programming
     'on 21 January 2001:
     'http://google.com/groups?selm=VA.00000b2f.0028c7e5%40mara9"
     Const c As String = ","
     Dim pgSetup As String
     Dim head As String
     Dim foot As String
     If LeftHead <> "" Then head = "&L" & LeftHead
     If CenterHead <> "" Then head = head & "&C" & CenterHead
     If RightHead <> "" Then head = head & "&R" & RightHead
     If Not head = "" Then head = """" & head & """"
     If LeftFoot <> "" Then foot = "&L" & LeftFoot
     If CenterFoot <> "" Then foot = foot & "&C" & CenterFoot
     If RightFoot <> "" Then foot = foot & "&R" & RightFoot
     If Not foot = "" Then foot = """" & foot & """"
        
     pgSetup = "PAGE.SETUP(" & head & c & foot & c & _
       LeftMarginInches & c & RightMarginInches & c & _
       TopMarginInches & c & BottomMarginInches & c & _
       PrintHeadings & c & PrintGridlines & c & _
       CenterHorizontally & c & CenterVertically & c & _
       Orientation & c & PaperSize & c & Zoom & c & _
       FirstPageNumber & c & Order & c & BlackAndWhite & c & _
       PrintQuality & c & HeaderMarginInches & c & _
       FooterMarginInches & c & PrintComments & c & Draft & ")"
     Application.ExecuteExcel4Macro pgSetup
   End Sub

Note that you need to activate each sheet when using this.

[Rick_Stanich]

Thanks for the help and tips!