Excel - Automatically add footer
Snippet Menu
2
Fri. Oct. 6th, 2006 3:12 PM
This macro will add a footer to your Excel worksheets. I use this at work because every Excel spreadsheet I do has to have my department and initials in the footer. This macro checks to make sure you are the author of the workbook, and it will not overwrite an existing footer. Just place this code in your personal macro workbook in the ThisWorkbook object.
Private WithEvents app As Application
Private Sub Workbook_Open()
Set app = Application
End Sub
Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
' add the footers to each sheet when the workbook is saved
' check the author of the workbook
For Each p In Wb.BuiltinDocumentProperties
If p.Name = "Author" Then
' if the author matches continue to add the footers to each sheet
If p.Value = Application.UserName Then
Dim sht As Worksheet
For Each sht In Wb.Sheets
With sht.PageSetup
If .RightFooter = "" Then ' do not overwrite an existing footer
.RightFooter = "Right footer text!!"
End If
If .LeftFooter = "" Then
.LeftFooter = "Left footer text!!"
End If
If .CenterFooter = "" Then
.CenterFooter = "Center footer text!!"
End If
End With
Next
End If
Exit Sub
End If
Next
End Sub
Comments
Voting
Votes Up
Votes Down
There are currently no comments for this snippet.