studeggle
asked on
Automated Footer with VB
We have a problem with lots of different people working the same file, printing of hard copies and then they end up getting mixed up and no-one knows which one is the latest without careful and painstaking studing and collaboration. So I want to add a VB script to the document that will automatically update a footer each time the document is saved, hence no more confusion. I did a search and picked up the following VB script for Excel from ture (Ture Magnusson) in a post to another person's question and it helps with what I want but has some shortcomings that I would like to try and change.
It only does the Date in the footer. I want my footer to read "FileName Date Vers #" FileName would be whatever the file is called, Date would be the file was last saved, and Vers # I would like to count upwards each time the file is saved.
And as if that wasn't enough I would like to also do this with Word and PowerPoint if at all possible.
VB script:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.PageSetup.RightFooter = Date
Next ws
End Sub
Can anyone help me rewrite this script to do what I want, or at least get closer. I do understand that I will probably need different scripts for each type of document--that is not a problem.
Thanks,
David Eggleston
It only does the Date in the footer. I want my footer to read "FileName Date Vers #" FileName would be whatever the file is called, Date would be the file was last saved, and Vers # I would like to count upwards each time the file is saved.
And as if that wasn't enough I would like to also do this with Word and PowerPoint if at all possible.
VB script:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.PageSetup.RightFooter = Date
Next ws
End Sub
Can anyone help me rewrite this script to do what I want, or at least get closer. I do understand that I will probably need different scripts for each type of document--that is not a problem.
Thanks,
David Eggleston
ASKER
That works wonderfully :D Thank you for the quick responce. I don't supose you know how to tackle the other part of the question "And as if that wasn't enough I would like to also do this with Word and PowerPoint if at all possible."?
David,
I'd like to tackle the problem of making the code work in Word & PowerPoint. I'll have time either tonight or tomorrow.
Brad
I'd like to tackle the problem of making the code work in Word & PowerPoint. I'll have time either tonight or tomorrow.
Brad
ASKER
That will work :D
David,
Which version(s) of Office are people using?
Brad
Which version(s) of Office are people using?
Brad
ASKER
Office XP
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
David,
For PowerPoint, you will also need to create a class module, using the same approach as for Word. I named it EventClassModule once again. One big difference is that I didn't find a Presentation_Open event that would run when the presentation was opened. Instead, it only ran when you opened a second presentation. As a result, the event class must be registered manually by running the RegisterEventClass macro after the presentation has opened.
Another difference is the fact that PowerPoint produces both slides and notes. I didn't know whether you wanted the footer in the slides or notes, so the code includes both.
'Code for class module
Public WithEvents appPP As PowerPoint.Application 'This statement must go above any subs or functions
Private Sub appPP_PresentationSave(ByV al Pres As Presentation)
Dim str As String
Dim VersionNumber As Variant
VersionNumber = ActivePresentation.BuiltIn DocumentPr operties(" Revision number")
str = ActivePresentation.Name & " " & Format(Date, "mm/dd/yyyy") & " Vers #" & VersionNumber
If ActivePresentation.HasTitl eMaster Then
With ActivePresentation.TitleMa ster.Heade rsFooters
With .Footer
.Text = str
.Visible = msoTrue
End With
'.SlideNumber.Visible = msoFalse
End With
End If
With ActivePresentation.SlideMa ster.Heade rsFooters
With .Footer
.Text = str
.Visible = msoTrue
End With
'.SlideNumber.Visible = msoFalse
End With
With ActivePresentation.Slides. Range.Head ersFooters
With .Footer
.Text = str
.Visible = msoTrue
End With
'.SlideNumber.Visible = msoFalse
End With
With ActivePresentation.NotesMa ster.Heade rsFooters
.Footer.Text = str
End With
End Sub
'Code for regular module sheet:
Dim X As New EventClassModule 'This statement must go above any subs or functions
Sub RegisterEventClass()
Set X.appPP = PowerPoint.Application
End Sub
To test the code, run the RegisterEventClass sub to register the class module (only need to do this once), then click the Save button.
Brad
For PowerPoint, you will also need to create a class module, using the same approach as for Word. I named it EventClassModule once again. One big difference is that I didn't find a Presentation_Open event that would run when the presentation was opened. Instead, it only ran when you opened a second presentation. As a result, the event class must be registered manually by running the RegisterEventClass macro after the presentation has opened.
Another difference is the fact that PowerPoint produces both slides and notes. I didn't know whether you wanted the footer in the slides or notes, so the code includes both.
'Code for class module
Public WithEvents appPP As PowerPoint.Application 'This statement must go above any subs or functions
Private Sub appPP_PresentationSave(ByV
Dim str As String
Dim VersionNumber As Variant
VersionNumber = ActivePresentation.BuiltIn
str = ActivePresentation.Name & " " & Format(Date, "mm/dd/yyyy") & " Vers #" & VersionNumber
If ActivePresentation.HasTitl
With ActivePresentation.TitleMa
With .Footer
.Text = str
.Visible = msoTrue
End With
'.SlideNumber.Visible = msoFalse
End With
End If
With ActivePresentation.SlideMa
With .Footer
.Text = str
.Visible = msoTrue
End With
'.SlideNumber.Visible = msoFalse
End With
With ActivePresentation.Slides.
With .Footer
.Text = str
.Visible = msoTrue
End With
'.SlideNumber.Visible = msoFalse
End With
With ActivePresentation.NotesMa
.Footer.Text = str
End With
End Sub
'Code for regular module sheet:
Dim X As New EventClassModule 'This statement must go above any subs or functions
Sub RegisterEventClass()
Set X.appPP = PowerPoint.Application
End Sub
To test the code, run the RegisterEventClass sub to register the class module (only need to do this once), then click the Save button.
Brad
David,
It turns out that PowerPoint will support automatic events when you open a presentation file provided you install an add-in that registers the class module. Here's a link to the required code, developed by PowerPoint MVP Shyam Pillai http://www.mvps.org/skp/autoevents.htm
Brad
It turns out that PowerPoint will support automatic events when you open a presentation file provided you install an add-in that registers the class module. Here's a link to the required code, developed by PowerPoint MVP Shyam Pillai http://www.mvps.org/skp/autoevents.htm
Brad
Here is a modification of Ture's sub that adds the filename, date and version number to the footer. The version number is stored in a named formula associated with the file. This sub goes in the ThisWorkbook code pane.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim str As String
Dim VersionNumber As Variant
On Error Resume Next
VersionNumber = Mid(ThisWorkbook.Names("Ve
If Err <> 0 Then
ThisWorkbook.Names.Add Name:="VersionNumber", RefersTo:="=1", Visible:=False
VersionNumber = 1
Err.Clear
End If
On Error GoTo 0
ThisWorkbook.Names("Versio
str = ThisWorkbook.Name & " " & Format(Date, "mm/dd/yyyy") & " Vers #" & VersionNumber
For Each ws In ThisWorkbook.Worksheets
ws.PageSetup.RightFooter = str
Next ws
End Sub
Cheers!
Brad