'.................................................................................
'header/footer syntax
'Font Change:
'A font Change is an ampersand, then a quote, the font name,
'then the font style, then another quote.
'Font Style Values can be: "Bold, Italic, BoldItalic, Regular"
'Example: &"Arial,Bold"
'myStr = "&""Arial,Bold"""
'Standalone Sytle Tags:
'&U = Underline
'&E = Double Underline
'&S = Strike Through
'&Y = SubScript
'&X = Superscipt
'Function Tags():
'&P = Page
'&N = Pages
'&D = Date
'&T = Time
'&Z = Path
'&F = File
'&A = Tab
'
'*Notes:
'Style Tags my be "closed" by adding another tag of the same type.
'(ex "Normal &U Undeline&U Normal")
'The total character count for all three segments of the header
'may not exceed 255 characters. The same hold true of footers.
'There is a &G tag that is used as an image place holder.
'However you set an image via the HeaderPicture Properties
'and the tag is automatically inserted.
'Passing default Printer Name
Sub PrintSetup(strCurrentPrinter As String)
Dim M As Long, N As Long
'Speeding Up VBA Code
Application.ScreenUpdating = False 'Prevent screen flickering
Application.Calculation = False 'Preventing calculation
Application.DisplayAlerts = False 'Turn OFF alerts
Application.EnableEvents = False 'Prevent All Events
Application.DisplayStatusBar = False
Dim ws As Worksheet
For Each ws In Worksheets
'Excludes "Mod", "Original" and "Job Book"
'InStr(1, ws.Name, "Mod", vbTextCompare) = 0 ' 0 means False
If InStr(1, ws.Name, "Mod", vbTextCompare) = 0 _
And InStr(1, ws.Name, "Things To Do", vbTextCompare) = 0 _
And InStr(1, ws.Name, "Input", vbTextCompare) = 0 _
And InStr(1, ws.Name, "Sample", vbTextCompare) = 0 _
And InStr(1, ws.Name, "Page Setup", vbTextCompare) = 0 Then
With ws.PageSetup
'.DisplayPageBreaks = False 'Speed up vba code
'If you are inserting/deleting hiding/unhiding rows (rows/columns) or changing page layout in any way. Turn off PageBreaks.
.LeftFooter = "&A"
.CenterFooter = "Printed &D &T"
.RightFooter = "Page &P of &N"
.PrintTitleRows = "$1:$1"
.PrintArea = ws.UsedRange.Address
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
'.DisplayPageBreaks = True
End With
End If
Next ws
'Speeding Up VBA Code
Application.ScreenUpdating = True 'Prevent screen flickering
Application.Calculation = True 'Preventing calculation
Application.DisplayAlerts = True 'Turn OFF alerts
Application.EnableEvents = True 'Prevent All Events
Application.DisplayStatusBar = True
End Sub
'To change printers to speed up process
Private Sub PrintToAnotherPrinter()
Dim strCurrentPrinter As String
strCurrentPrinter = Application.ActivePrinter ' store the current active printer
On Error Resume Next ' ignore printing errors
Application.ActivePrinter = "Microsoft XPS Document Writer on Ne00:" ' change to another printer
Call PrintSetup(strCurrentPrinter)
Application.ActivePrinter = strCurrentPrinter ' change back to the original printer
On Error GoTo 0 ' resume normal error handling
End Sub