Macro For Datestamp On ALL Pages Not Working In 2010

Hatman58 · #1 08-22-2014, 12:01 PM

We have a macro that was recorded in PP2003 to update the Master Notes & Notes Pages with a Date & Time stamp in the footer.
Everything worked fine in 2003 but it fails in 2010. It only updates the Master but does not update the Notes.

And we can't record a new macro in 2010 (why would MS remove this feature? )
In any case, following is the VBA which I am not very familiar with at all. Hence the frustration associated with not being able to Record a Macro.
Is there something missing that is needed to be able to update the Master AND the Notes pages?
Thanks for any help on this!

Code:

Sub Footer_Right()
ActiveWindow.ViewType = ppViewNotesMaster
ActivePresentation.NotesMaster.Shapes("Rectangle 7").Select
With ActiveWindow.Selection.ShapeRange
.Fill.Transparency = 0#
.Height = 32
.Width = 300
.Left = 235
.Top = 690
End With
With ActiveWindow.Selection.ShapeRange
.Fill.Transparency = 0#
.Left = 229.5
End With
ActiveWindow.Selection.ShapeRange.Fill.Transparency = 0#
ActivePresentation.NotesMaster.Shapes("Rectangle 7").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=55).Select
ActiveWindow.Selection.TextRange.Text = ""
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "Page "
With .Font
.Name = "Arial"
.Size = 11
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(Red:=88, Green:=48, Blue:=151)
End With
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=6, Length:=0).InsertSlideNumber
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=9, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = Chr$(CharCode:=13)
With .Font
.Name = "Arial"
.Size = 11
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(Red:=88, Green:=48, Blue:=151)
End With
End With
ActiveWindow.Selection.Unselect
ActivePresentation.NotesMaster.Shapes("Rectangle 7").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=10, Length:=0).Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=27, Length:=0).InsertDateTime DateTimeFormat:=ppDateTimedMMMMyyyy, InsertAsField:=msoFalse
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=43, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = " "
With .Font
.Name = "Arial"
.Size = 11
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(Red:=88, Green:=48, Blue:=151)
End With
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=45, Length:=0).InsertDateTime DateTimeFormat:=ppDateTimehmmAMPM, InsertAsField:=msoFalse
ActiveWindow.ViewType = ppViewNotesPage
ActiveWindow.ViewType = ppViewNotesPage
End Sub

JohnWilson · #2 08-22-2014, 11:32 PM

Your code should actually work in 2010 as long as the shape called Rectangle 7 exists.

The main reason the recorder was dropped in PPT was that it produced appalling unreliable code and PowerPoint had become much more complex and many items no longer worked at all.

See if this gets you closer.

Code:

Sub fixCode()
Dim newShp As Shape
On Error Resume Next
ActivePresentation.NotesMaster.Shapes("DATEFOOTER").Delete
Set newShp = ActivePresentation.NotesMaster.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=229.5, _
Top:=690, _
Width:=300, _
Height:=32)
newShp.Name = "DATEFOOTER"
With newShp.TextFrame.TextRange
.ParagraphFormat.Alignment = ppAlignCenter
.Font.Name = "Arial"
.Font.Size = 11
.Font.Color.RGB = RGB(Red:=88, Green:=48, Blue:=151)
.Text = "Page ": .InsertSlideNumber: .InsertAfter Chr(13)
.InsertDateTime ppDateTimedMMMMyyyy: .InsertAfter " ": .InsertDateTime ppDateTimehmmAMPM
End With
End Sub

Hatman58 · #3 08-26-2014, 05:14 AM

Thanks John,
Your code did the trick.

Our code did update the Notes Master but did not update all the Notes Pages as it did in 2003. (Rectangle 7 is there)

Thanks again for your assistance.

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to update ole links not working	kisa500	PowerPoint	7	02-05-2013 03:52 AM
Word 2010 Page Color not working in macro	Sorceress	Word	3	10-15-2012 06:02 AM
Macro for selecting pages and formatting of tables	ubns	Word VBA	25	08-15-2012 11:48 PM
Fraction macro not working	Ulodesk	Word VBA	1	07-18-2012 04:01 PM
Splitting multiple pages using macro	F5JASON	Excel Programming	0	07-27-2011 08:22 AM