Add the current path and file to every slide
This sets the footer text to the current presentation's full path and file name.
Sub FilenameInFooter()
Dim FooterText As String
' And set it to the current presentation's full path/name
FooterText = ActivePresentation.FullName
' or if you prefer just the name use
' FooterText = ActivePresentation.Name
If ActivePresentation.HasTitleMaster Then
With ActivePresentation.TitleMaster.HeadersFooters
With .Footer
.Text = FooterText
.Visible = msoTrue
End With
End With
End If
With ActivePresentation.SlideMaster.HeadersFooters
With .Footer
.Text = FooterText
.Visible = msoTrue
End With
End With
With ActivePresentation.Slides.Range.HeadersFooters
With .Footer
.Text = FooterText
.Visible = msoTrue
End With
End With
End Sub
Here's a different approach. This adds a text shape to each slide and adds the filename and date to it.
If there's already a text box from a previous use of the macro, the macro uses the existing box, otherwise it creates one.
Sub AddTextBoxDateFilename()
' Adds a text box with date and filename to each slide
' You must first save the presentation at least once before using this
Dim oSl As Slide
Dim oSh As Shape
On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
' do we already have a filename/date text box? If do, use it:
On Error Resume Next
Set oSh = oSl.Shapes("FilenameAndDate")
On Error GoTo ErrorHandler
If oSh Is Nothing Then ' no text box there already, create one
' change the position and formatting to suit your needs:
Set oSh = oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 510, 720, 28.875)
With oSh
.Name = "FilenameAndDate"
.TextFrame.WordWrap = msoTrue
With .TextFrame.TextRange.ParagraphFormat
.LineRuleWithin = msoTrue
.SpaceWithin = 1
.LineRuleBefore = msoTrue
.SpaceBefore = 0.5
.LineRuleAfter = msoTrue
.SpaceAfter = 0
End With
With .TextFrame.TextRange.Font
.NameAscii = "Arial"
.Size = 18
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With ' shape
End If ' osh is nothing
' now we know there's a shape by the correct name so
Set oSh = oSl.Shapes("FilenameAndDate")
With oSh.TextFrame.TextRange
.Text = ActivePresentation.FullName & vbTab & Format(Now, "mmmm dd, yyyy")
End With
Set oSh = Nothing
Next ' slide
NormalExit:
Exit Sub
ErrorHandler:
MsgBox ("There was a problem:" _
& vbCrLf _
& Err.Description)
Resume NormalExit
End Sub
See How do I use VBA code in PowerPoint? to learn how to use this example code.