Try
For Each Sh In ActiveWindow.SelectedSheets
Sh.Activate
Read also this thread 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
--
Regards Ron de Bruin
http://www.rondebruin.nl
"Agustus" wrote in message oups.com...
I have the following code which produced error:
Sub formatallselected()
Dim Sh As Worksheet
For Each Sh In activeworkbooks.SelectedSheets
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AA$35"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&A"
.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 = False
.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 = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
Next
End Sub
Can someone kind enough to help? Any comment is much appreciated.
TIA