Thread: [Solved] Image page numbering macro
View Single Post
 
Old 08-16-2012, 06:33 AM
JohnWilson JohnWilson is offline Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,914
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

This doesn't create an image but it should get you close

Code:
Sub picNums()
Dim osld As Slide
Dim lngCount As Long
Dim L As Long
Dim sH As Long
lngCount = ActivePresentation.Slides.Count
sH = ActivePresentation.PageSetup.SlideHeight
Call zapper
For Each osld In ActivePresentation.Slides
osld.HeadersFooters.SlideNumber.Visible = True
If Not getNum(osld) Is Nothing Then
With getNum(osld).TextFrame.TextRange.Font
.Size = 16
.Color.RGB = vbBlack
.Bold = True
End With
End If
    With osld.Shapes
        For L = 1 To lngCount
        With .AddShape(msoShapeIsoscelesTriangle, L * 15, sH - 12, 12, 12)
            .Name = "PicNum" & CStr(L)
            If osld.SlideIndex <> L Then
            .Fill.ForeColor.RGB = vbYellow
            .Line.Visible = False
            Else
            .Fill.ForeColor.RGB = vbBlack
            .Line.Visible = False
            End If
        End With
        Next L
    End With
Next osld
End Sub

Sub zapper()
Dim osld As Slide
Dim i As Integer
For Each osld In ActivePresentation.Slides
For i = osld.Shapes.Count To 1 Step -1
If osld.Shapes(i).Name Like "PicNum*" Then osld.Shapes(i).Delete
Next i
Next osld
End Sub
Function getNum(osld As Slide) As Shape
Dim oshp As Shape
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
Set getNum = oshp
Exit Function
End If
End If
Next oshp
End Function
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote