Another .PageSetup Thread (xl2010)

[Clif McIrvin]

xl2010

I'm attempting to create a macro to install a set of headers and footers
that I only ocassionally use. Long ago I created a .xlt; but I find that
in most cases I want to add the headers / footers to an existing sheet
so the template isn't really being very helpful.

Working from the template, I used the macro recorder to create some
initial code, which I have slightly customized. What I am finding is
that if I disable all the

Application.PrintCommunication = False

statements that the recorder put in the macro does what I want; but if I
leave them in place the results are unpredictable.

Evidently either a) I'm too impatient and not waiting for all the cached
commands to execute, b) commands are getting lost and/or mangled in the
cache or c) something else <grin>.

If someone has a solution that'd be great ... if not, at least the code
does what I want, albeit slowly (still faster than manually!!) if I
leave PrintCommunication on.

Here's the code I'm working with:

Sub AddDefaultHeaders()

If ActiveSheet Is Nothing Then
Exit Sub
End If

ActiveSheet.PageSetup.LeftHeaderPicture.FileName = _
"C:\Documents and Settings\username\My Documents\" _
& "My Pictures\logo.png"
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 69
.Width = 82.5
End With

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.6)
.RightMargin = Application.InchesToPoints(0.6)
.TopMargin = Application.InchesToPoints(1.11)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.31)
.FooterMargin = Application.InchesToPoints(0.2)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
.LeftHeader = "&G"
'Application.Wait 1000
'DoEvents
.CenterHeader = _
"&""Century Schoolbook,Bold""&16My Company Name "
.RightHeader = "&""Century Schoolbook,Bold""&9Quality" _
& Chr(10) & "Assurance"
.LeftFooter = "&9&Z" & Chr(10) & "&F"
.CenterFooter = ""
.RightFooter = "&9Printed &D &T"
End With
Application.PrintCommunication = True
ActiveSheet.PrintPreview EnableChanges:=True
End Sub

 

[GS]

Clif,
Did you give McGimpsey's rework of John Green's XL4M solution a shot?

 

[Clif McIrvin]

Clif,
Did you give McGimpsey's rework of John Green's XL4M solution a shot?

Not yet ... I'll post my results when I have done that.

 

[Clif McIrvin]

Clif,
Did you give McGimpsey's rework of John Green's XL4M solution a shot?

Now I have done that.

After taking the screen updating out of my original code, and using a
hand-held stop watch to measure between clicking the toolbar button to
launch the macro and seeing the print preview appear I have these times
(average of 3 attempts):

Original Code: 2.4 seconds
As posted below: ~0.9 seconds
With PrintCommunication disabled after the XL4M call: ~1.15 seconds

Note the stacked (4 deep!) full quotes [ """" ] around the font names.

Code begins ----------------- (2 procs)

Sub AddDefaultHeaders()

If ActiveSheet Is Nothing Then
Exit Sub
End If

With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With '//Application

ActiveSheet.PageSetup.LeftHeaderPicture.FileName = _
"C:\Documents and Settings\username\My Documents\My
Pictures\logo.png"
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 69
.Width = 82.5
End With

' Unpredictable results with False ...
'Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With

Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""

' using McGimpsey's rework of John Green's XL4M solution
' reduces execution time from about 2.4 to about 0.9 seconds
PageSetupXL4M LeftHead:="&G", _
CenterHead:="&""""Century Schoolbook,Bold""""&16McPherson " _
& "Concrete Products ", _
RightHead:="&""""Century Schoolbook,Bold""""&9Quality" _
& Chr(10) & "Assurance", _
LeftFoot:="&9&Z" & Chr(10) & "&F", _
RightFoot:="&9Printed &D &T", _
LeftMarginInches:=0.6, _
RightMarginInches:=0.6, TopMarginInches:=1.11, _
BottomMarginInches:=0.5, HeaderMarginInches:=0.31, _
FooterMarginInches:=0.2, PrintHeadings:=False, _
PrintGridlines:=False, PrintComments:=xlPrintNoComments, _
PrintQuality:=600, CenterHorizontally:=True, _
CenterVertically:=False, Orientation:=xlPortrait, _
Draft:=False, PaperSize:=xlPaperLetter, _
FirstPageNumber:=xlAutomatic, Order:=xlDownThenOver, _
BlackAndWhite:=False, Zoom:=100

' disabling PrintCommunication here appears to result
' in a slight increase in required execution time
'Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With

Application.PrintCommunication = True
ActiveSheet.PrintPreview EnableChanges:=True

With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With '//Application

End Sub

' John McGimpsey's adaptation of a John Green macro
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)

Const c As String = ","
Dim pgSetup As String, head As String, 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 'PageSetupXL4M()

 

[GS]

In the tests I did, my times (using timer) were less than .5 secs per
sheet with McG's version of JG's code. Just for interest I tried JG's
code as posted and got similar results, verifying that McG's version
runs without penalty!

That said, I have no desire to pursue playing around with hardware
settings, partly due to the unsurprising result you got trying to set
ActivePrinter, but mostly due to the very impressive results using
XL4M.

 

[Clif McIrvin]

In the tests I did, my times (using timer) were less than .5 secs per
sheet with McG's version of JG's code. Just for interest I tried JG's
code as posted and got similar results, verifying that McG's version
runs without penalty!

That said, I have no desire to pursue playing around with hardware
settings, partly due to the unsurprising result you got trying to set
ActivePrinter, but mostly due to the very impressive results using
XL4M.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

And thank you for the time you spent investigating and testing! It
certainly provided a very definite benefit to me <smile>

 

[GS]

And thank you for the time you spent investigating and testing! It certainly

provided a very definite benefit to me <smile>

Well, I'm sorry I didn't provide the correct version of my GroupSheets
proc. I'm out of town at the moment and don't have access to my (home)
network. I only had the unrevised version in PERSONAL.XLS and tried to
improvise with that here. (Just didn't get around to updating it with
the recenyt version, yet) The line with the 'AND' operator was used to
edit an array used to populate a listbox as users selected sheets to
group from a main listbox. This was a task-specific feature handle in a
userform where users selected sheets in lstSheetsList followed by
selecting criteria in a combobox, where the sheets were copied to a new
workbook for a specific department. The selected sheets were listed in
lstSheets1 and unselected sheets were listed in lstSheets2 so these
could be grouped to copy into a new wkb for another department. The
result was each department got their respective monthly reports and the
original file was kept intact for future ref. I had facilitated the
management of sheetnames inside my GroupSheets proc for this project,
but decided it could be a stand-alone reusable proc for the purpose of
grouping sheets.

My version is adapted from original code I got from Rob Bovey. I have a
tendancy to get projects working before doing code
refinements/optimizations and so some stuff is <IMO> usually 'in the
rough' longer than I'd like due to not getting time to get at it.<g>