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