Automatic update of footer macro

G

Guest

I'm posting this for a user who sent me the following query, which I've
inserted below as submitted to me:

"Hi ,

Don't know if you know any VBA but I have a problem that I haven't been able
to resolve. I don't know any VBA but I can usually cheat by looking
something up via google or recording a macro and transferring and altering
parts of the code to do what I need it to do. But I haven't been able to
figure this one out:

I have a footer macro that I set up to include the "last author" and "last
modified" items rather than the current date/time and the original author.
The problem with my footer is that it doesn't update these items
automatically when I save. It will only update if I re-run the macro to
insert the footer. (This is the same problem as with using the regular
pathname footer in Excel - which doesn't update when you use save as and save
a file with the pathname in the footer to a new location.)

Sub Footer()
'
' Footer Macro
' Macro recorded 3/26/2007 by atao
'

ActiveSheet.PageSetup.LeftFooter = "&8Last Modified by " & ActiveWorkbook. _
BuiltinDocumentProperties("last author").Value & " " &
ActiveWorkbook. _
BuiltinDocumentProperties("last save time") & Chr(10) & "&Z&F\&A"

ActiveSheet.PageSetup.RightFooter = "&8&P of &N"

End Sub


So, I am either trying to find a way for those items to auto-update as does
current date and time (when you use &[date] &[time] (which I have a feeling
can't be done for Builtin Document Properties or have the macro re-run
automatically upon saving. I found something called "OnAction" property that
may do the trick when save is pressed but I actually don't know any VBA so I
thought maybe you would be able to help me?"
 
J

JE McGimpsey

One way:

Put these in the ThisWorkbook code module:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
With ws.PageSetup
.LeftFooter = "&8Last Modified by " & _
Me.BuiltinDocumentProperties("last author").Value & _
" " & Me.BuiltinDocumentProperties( _
"last save time").Value & _
Chr(10) & "&Z&F\&A"
.RightFooter = "&8&P of &N"
End With
Next ws
End Sub

Private Sub Workbook_BeforeSave( _
ByVal SaveAsUI As Boolean, Cancel As Boolean)
With Me.BuiltinDocumentProperties
.Item("last author").Value = Application.UserName
.Item("last save time") = Now
End With
End Sub
 
G

Gord Dibben

Greg

You could put the code into Thisworkbook module inside a BeforeSave event or a
BeforePrint event.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)

ActiveSheet.PageSetup.LeftFooter = "&8Last Modified by " & ActiveWorkbook. _
BuiltinDocumentProperties("last author").Value & " " & _
ActiveWorkbook. _
BuiltinDocumentProperties("last save time") & Chr(10) & "&Z&F\&A"
ActiveSheet.PageSetup.RightFooter = "&8&P of &N"

End Sub


Gord Dibben MS Excel MVP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Excel Unique last page footer 1
excel footer 2
Multiple lines in Footer with VBA 7
Excel Multiple sheet updates 1
Macro Update Macro 1
Footer 6
Font size 2
Macro Help, continued 4

Top