VB ProcessBar

ProcessBar.bas

Sub ProgressBar()
' by dukenuke@newsmth.net
' Sun Jul 11 00:06:13 2010 

    Dim mySlides As Slides
    Dim pageBar As ShapeRange
    Dim pageSHower As Shape
    Dim pageWidth, pageHeight, pageStep
    
    Set mySlides = Application.ActivePresentation.Slides

    pageWidth = Application.ActivePresentation.SlideMaster.Width
    pageHeight = Application.ActivePresentation.SlideMaster.Height
    pageStep = pageWidth / mySlides.Count

    On Error Resume Next

    For i = 2 To mySlides.Count
        Set pageBar = mySlides.Item(i).Shapes.Range(Array())
        Set pageBar = _
           mySlides.Item(i).Shapes.Range(Array("RectanglePageNum"))

        If IsNull(pageBar) Or pageBar.Count = 0 Then GoTo newBar
        Set pageSHower = pageBar.Item(1)
        GoTo nextPage

newBar:
        Set pageSHower = mySlides.Item(i).Shapes.AddShape( _
                           msoShapeRectangle, 0, _
                           pageHeight - 3, i * pageStep, 3)
        pageSHower.Name = "RectanglePageNum"

nextPage:
        pageSHower.Fill.ForeColor.RGB = RGB(64, 64, 64)
        pageSHower.Line.Visible = msoFalse
        pageSHower.Width = i * pageStep
        pageSHower.Top = pageHeight - 8
        pageSHower.Left = 0
        pageSHower.Height = 8

    Next
End Sub