Wednesday, November 02, 2005
Add footer to all the worksheets in a workbook
Using this code you can add the same footer to all the worksheets in your workbook. It'll ask you for Left, Center and Right footer. Please note that if you want to print all the worksheets with continious page numbers you'd have to select all the worksheets at the same time. This code will do it for select all the worksheets. If you don't want continious page number select a single sheet.
'This sub will add the same footer to all the worksheets in your activeworkbook _
' and select them and view in printpreview
Sub PrintSettings()
Dim sht As Worksheet, arrShtNames() As String, shtCount As Long
Dim strLfooter As String, strCfooter As String, strRFooter As String
strLfooter = InputBox("Enter the left footer", "Left footer", ThisWorkbook.Name)
'&D will print the date
strCfooter = InputBox("Enter the center footer", "Ccenter footer", "&D")
'&P of &N will print page numbers like this: 1 of 5
strRFooter = InputBox("Enter the right footer", "Right footer", "&P of &N")
'copy the footer to all the sheets
Application.ScreenUpdating = False
For Each sht In ActiveWorkbook.Worksheets
sht.Activate
With ActiveSheet.PageSetup
.LeftFooter = strLfooter
.CenterFooter = strCfooter
.RightFooter = strRFooter
End With
shtCount = shtCount + 1
ReDim Preserve arrShtNames(shtCount - 1)
arrShtNames(shtCount - 1) = sht.Name
Next sht
Sheets(arrShtNames).Select
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
End Sub
' and select them and view in printpreview
Sub PrintSettings()
Dim sht As Worksheet, arrShtNames() As String, shtCount As Long
Dim strLfooter As String, strCfooter As String, strRFooter As String
strLfooter = InputBox("Enter the left footer", "Left footer", ThisWorkbook.Name)
'&D will print the date
strCfooter = InputBox("Enter the center footer", "Ccenter footer", "&D")
'&P of &N will print page numbers like this: 1 of 5
strRFooter = InputBox("Enter the right footer", "Right footer", "&P of &N")
'copy the footer to all the sheets
Application.ScreenUpdating = False
For Each sht In ActiveWorkbook.Worksheets
sht.Activate
With ActiveSheet.PageSetup
.LeftFooter = strLfooter
.CenterFooter = strCfooter
.RightFooter = strRFooter
End With
shtCount = shtCount + 1
ReDim Preserve arrShtNames(shtCount - 1)
arrShtNames(shtCount - 1) = sht.Name
Next sht
Sheets(arrShtNames).Select
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
End Sub
