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