VBA Help - Moving Page Numbers in Each Slide in PPT

Hi,

I am trying to loop through each slide in ppt and move the page number to a new location. The code below seems to work for only the selected slide but not for all slides in the ppt.

Sub MovePageNumber()

Dim sld as Slide
Dim j as Shape

For Each sld In ActivePresentation.Slides
Set j = ActiveWindow.Selection.SlideRange.Shapes("PageNumber")

j.Left = 775
j.Top = 5

Next sld

End Sub

Many thanks in advance!

Like this but NOTE your measurements might put the number off slide This is for a PC it will not work on a Mac

Code:

---

Sub MovePageNumber()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
Set oshp = getNumber(osld)
If Not oshp Is Nothing Then
oshp.Left = 775
oshp.Top = 5
End If
Next oshp
Next osld
End Sub


Function getNumber(osld As Slide) As Shape
For Each getNumber In osld.Shapes
If getNumber.Type = msoPlaceholder Then
If getNumber.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
Exit For
End If
End If
Next
End Function

---

Thank you! This worked great when I tested it using the automated slide number function in a new workbook; however, the code isn't working for

the workbook that I am working in. I think that the issue is that the p

age numbers were not inserted through the slide number function and certain slides are skipped in the numbering and do not have page numbers on them. The original code I had was recognizing the page number and moving it for whatever my active slide was but wasn't looping through all of the slides.

Quote:

---

Originally Posted by John Wilson

Like this but NOTE your measurements might put the number off slide This is for a PC it will not work on a Mac

Code:

---

Sub MovePageNumber()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
Set oshp = getNumber(osld)
If Not oshp Is Nothing Then
oshp.Left = 775
oshp.Top = 5
End If
Next oshp
Next osld
End Sub


Function getNumber(osld As Slide) As Shape
For Each getNumber In osld.Shapes
If getNumber.Type = msoPlaceholder Then
If getNumber.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
Exit For
End If
End If
Next
End Function

---

---

It's not easy to deal with numbers that have been added manually. You code only moved shapes name "SlideNumber" which is not the default. This would move any shape that has number in the name and might work. If you have "Don't show on Title Slide" ticked ANY slide with the title layout will not have numbers.



Sub MovePageNumber()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
Set oshp = getNumber(osld)
If Not oshp Is Nothing Then
oshp.Left = 775
oshp.Top = 5
End If
Next oshp
Next osld
End Sub




Function getNumber(osld As Slide) As Shape
For Each getNumber In osld.Shapes
If UCase(getNumber.Name) Like "*NUMBER*" Then
Exit For
End
End If
Next
End Function

You might also want to check that the numbers can be EDITED/MOVED manually. Maybe the original author added textboxes to the master (or used a very old version). In this case the correction would have to be made in master view.