Macro for Header and Footer in Excel

[ras2021]

I want to write a macro code for header and footer in MSEXCEL so that when printing command is given, it prints the header and footer already given in macro. No one print should come without header & Footer already given in macro.I tried but not working properly. Anyone could help me to achieve my aim.

Sub InsertHeaderFooter()
' inserts the same header/footer in all worksheets
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Application.StatusBar = "Changing header/footer in " & ws.Name
With ws.PageSetup
.LeftHeader = "Company name"
.CenterHeader = "Page &P of &N"
.RightHeader = "Printed &D &T"
.LeftFooter = "Path : " & ActiveWorkbook.Path
.CenterFooter = "Workbook name &F"
.RightFooter = "Sheet name &A"
End With
Next ws
Set ws = Nothing
Application.StatusBar = False
End Sub

 

[pbornemeier]

The code you posted can be run manually and does update the header and footer in each worksheet. You might want to change "Company Name" to "Company Name: " & the variable that contains the company name.

If you want the code to run automatically, you must put the code in the

Private Sub Workbook_BeforePrint(Cancel As Boolean)

End Sub

Sub in the ThisWorkbook code page for each workbook where you want the code to run.

The code runs slowly due to multiple communications with the printer (6 times for each worksheet).

If you are using Excel 2010 or newer you can use the following statements to save all of your commands to the printer to be sent at once

application.printcommunication = false
' PageSetup code here
application.printcommunication = true

For older versions of excel the following code can be used to speed printer communication. Informative link: McGimpsey & Associates : Excel : Bypassing Slow VBA PageSetup

   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)
     'Module code copied from: http://www.mcgimpsey.com/excel/udfs/pagesetup.html
     '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