Thanks for your help, I thought it should be as simple as changing the size
but I'm still struggling. I have tried using the two lines you suggested but
got no further.
The code I am using is:
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 = msoFalse
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 = 8
.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
