ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Sheet Group & Formating in VBA (https://www.excelbanter.com/excel-programming/307774-sheet-group-formating-vba.html)

Phatchef24[_3_]

Sheet Group & Formating in VBA
 
Hi,

I'm having problems with group multiple worksheets together an
giving them all the same Header & Footer. My current code looks lik
this:

Sheets(Array("Aggregate FY", "Aggregate Q1", "Aggregate Q2", "Aggregat
Q3", "Aggregate Q4", _
"Unit FY", "Unit Q1", "Unit Q2", "Unit Q3", "Unit Q4")).Select

With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "" & Chr(10) & "&""Arial,Bold""CONFIDENTIA
-- NOT FOR DISTRIBUTION"
.RightHeader = "&A"
.LeftFooter = "&D"
.CenterFooter = "&P of &N"
.RightFooter = "&F"
.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 = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With

So far the only sheet that is recieving the correct Header is the firs
sheet, "Aggregate FY". Any ideas what I'm missing or a better way to g
about this?

Thanks

--
Message posted from http://www.ExcelForum.com


Tom Ogilvy

Sheet Group & Formating in VBA
 
That is because grouping is largely not supported in VBA.

If you have one sheet set up, then KeepItCool has suggested this as a way to
format multiple sheets:


sheets(array("sheet2","sheet3","sheet4")).select
sheets("sheet3").activate
SendKeys "{enter}"
Application.Dialogs(xlDialogPageSetup).Show



keepITcool
-------------------------
Other than that you would need to loop through the sheets. You are probably
already aware that pagesetup is extremely slow. So you should only set
those attributes that you need to do because each setting is an individual
call to the slow pagesetup object.

somewhat faster is to use the xl4 macro approach posted here by John Green:

From: John Green )
Subject: Pagesetup code takes too long
Newsgroups: microsoft.public.excel.programming
View complete thread (5 articles)
Date: 1999/03/29


Macro =
"Page.Setup(,,.25,.25,.5,.25,,False,True,True,2,1, {1,1},,,,,.25,.25)"
ExecuteExcel4Macro Macro


HTH,

John Green - Excel MVP
Sydney
Australia



=================================
From: John Green )
Subject: About PageSetup..
Newsgroups: microsoft.public.excel.programming
View complete thread (10 articles)
Date: 2001-01-22 12:57:23 PST




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,
Tom Ogilvy



"Phatchef24 " wrote in message
...
Hi,

I'm having problems with group multiple worksheets together and
giving them all the same Header & Footer. My current code looks like
this:

Sheets(Array("Aggregate FY", "Aggregate Q1", "Aggregate Q2", "Aggregate
Q3", "Aggregate Q4", _
"Unit FY", "Unit Q1", "Unit Q2", "Unit Q3", "Unit Q4")).Select

With ActiveSheet.PageSetup
LeftHeader = ""
CenterHeader = "" & Chr(10) & "&""Arial,Bold""CONFIDENTIAL
-- NOT FOR DISTRIBUTION"
RightHeader = "&A"
LeftFooter = "&D"
CenterFooter = "&P of &N"
RightFooter = "&F"
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 = True
Orientation = xlLandscape
Draft = False
PaperSize = xlPaperLetter
FirstPageNumber = xlAutomatic
Order = xlDownThenOver
BlackAndWhite = False
Zoom = False
FitToPagesWide = 1
FitToPagesTall = 1
PrintErrors = xlPrintErrorsDisplayed
End With

So far the only sheet that is recieving the correct Header is the first
sheet, "Aggregate FY". Any ideas what I'm missing or a better way to go
about this?

Thanks!


---
Message posted from http://www.ExcelForum.com/





All times are GMT +1. The time now is 07:31 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com