G
gb0dms
I have a "tracker" Macro for our presentations basically placing the
filepath, date and time onto the master
now, I can get it to place on the Slide Master but in 2007 this does not
have an effect on 2 of the layouts so I cannot get it to place on the
Title Layout or the Section Header Layout
Here is my Code:
Sub AddOrUpdateTracker()
Dim DateAndTime As String
DateAndTime = StrConv(Format(Date, "mm/d/yy"), vbLowerCase) & " " & _
StrConv(Format(Time, "h:mm ampm"), vbLowerCase)
Dim i As Long
Dim text As TextFrame
RemoveTracker
For i = 1 To ActivePresentation.Designs.count 'will now apply this
for the number of designs present
ActiveWindow.ViewType = ppViewSlideMaster
With ActivePresentation.Designs(i).SlideMaster.Shapes.AddTextbox _
(msoTextOrientationHorizontal, 755, 0, 14.5, 21.625)
.Name = ("Tracker Box")
.TextFrame.WordWrap = msoFalse
With .TextFrame.TextRange
.ParagraphFormat.Alignment = ppAlignRight
.text = ActivePresentation.FullName & " " & DateAndTime
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Arial"
.Size = 8
.Bold = msoFalse
.Italic = msoTrue
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
End With
'This is the Problem Section
If ActivePresentation.Designs(i).HasTitleMaster Then
ActiveWindow.ViewType = ppViewTitleMaster
With ActivePresentation.Designs(i).TitleMaster.Shapes.AddTextbox _
(msoTextOrientationHorizontal, 755, 0, 14.5, 21.625)
.Name = ("Tracker Box")
.TextFrame.WordWrap = msoFalse
With .TextFrame.TextRange
.ParagraphFormat.Alignment = ppAlignRight
.text = ActivePresentation.FullName & " " & DateAndTime
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Arial"
.Size = 8
.Bold = msoFalse
.Italic = msoTrue
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
End With
End If
Next
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.View.gotoslide Index:=1
End Sub
'_____________________________
Sub RemoveTracker()
Dim i As Long
Dim iSlide As Long
On Error Resume Next
For i = 1 To ActivePresentation.Designs.count 'will now apply this
for the number of designs present
ActiveWindow.ViewType = ppViewSlideMaster
ActivePresentation.Designs(i).SlideMaster.Shapes("Tracker Box").Delete
If ActivePresentation.Designs(i).HasTitleMaster Then
ActiveWindow.ViewType = ppViewSlideMaster
ActivePresentation.Designs(i).SlideMaster.Shapes("Tracker
Box").Delete
End If
Next
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.Selection.Unselect
For iSlide = 1 To ActivePresentation.Slides.count
ActivePresentation.Slides(iSlide).Shapes("Tracker Box").Delete
Next
ActiveWindow.View.gotoslide Index:=1
End Sub
filepath, date and time onto the master
now, I can get it to place on the Slide Master but in 2007 this does not
have an effect on 2 of the layouts so I cannot get it to place on the
Title Layout or the Section Header Layout
Here is my Code:
Sub AddOrUpdateTracker()
Dim DateAndTime As String
DateAndTime = StrConv(Format(Date, "mm/d/yy"), vbLowerCase) & " " & _
StrConv(Format(Time, "h:mm ampm"), vbLowerCase)
Dim i As Long
Dim text As TextFrame
RemoveTracker
For i = 1 To ActivePresentation.Designs.count 'will now apply this
for the number of designs present
ActiveWindow.ViewType = ppViewSlideMaster
With ActivePresentation.Designs(i).SlideMaster.Shapes.AddTextbox _
(msoTextOrientationHorizontal, 755, 0, 14.5, 21.625)
.Name = ("Tracker Box")
.TextFrame.WordWrap = msoFalse
With .TextFrame.TextRange
.ParagraphFormat.Alignment = ppAlignRight
.text = ActivePresentation.FullName & " " & DateAndTime
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Arial"
.Size = 8
.Bold = msoFalse
.Italic = msoTrue
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
End With
'This is the Problem Section
If ActivePresentation.Designs(i).HasTitleMaster Then
ActiveWindow.ViewType = ppViewTitleMaster
With ActivePresentation.Designs(i).TitleMaster.Shapes.AddTextbox _
(msoTextOrientationHorizontal, 755, 0, 14.5, 21.625)
.Name = ("Tracker Box")
.TextFrame.WordWrap = msoFalse
With .TextFrame.TextRange
.ParagraphFormat.Alignment = ppAlignRight
.text = ActivePresentation.FullName & " " & DateAndTime
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Arial"
.Size = 8
.Bold = msoFalse
.Italic = msoTrue
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
End With
End If
Next
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.View.gotoslide Index:=1
End Sub
'_____________________________
Sub RemoveTracker()
Dim i As Long
Dim iSlide As Long
On Error Resume Next
For i = 1 To ActivePresentation.Designs.count 'will now apply this
for the number of designs present
ActiveWindow.ViewType = ppViewSlideMaster
ActivePresentation.Designs(i).SlideMaster.Shapes("Tracker Box").Delete
If ActivePresentation.Designs(i).HasTitleMaster Then
ActiveWindow.ViewType = ppViewSlideMaster
ActivePresentation.Designs(i).SlideMaster.Shapes("Tracker
Box").Delete
End If
Next
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.Selection.Unselect
For iSlide = 1 To ActivePresentation.Slides.count
ActivePresentation.Slides(iSlide).Shapes("Tracker Box").Delete
Next
ActiveWindow.View.gotoslide Index:=1
End Sub