#1
|
|||
|
|||
Macro For Datestamp On ALL Pages Not Working In 2010
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 |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
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. |
|
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 |