For Count = 1 To sectionLength
                        bulletCounter = bulletCounter + 1
                        Set s = slide.Shapes.AddShape(msoShapeOval, left, top, _
                          sizeOfBullet, sizeOfBullet)
                        s.Name = "PB_" & CStr(slideNumber)
 
                         If currentSlideNumber = slideNumber Then
                            s.Fill.ForeColor.RGB = RGB(colorRed, colorYellow, _
                              colorBlue)
                            s.Line.ForeColor.RGB = RGB(colorRed, colorYellow, _
                            colorBlue)
                        Else
                            s.Fill.ForeColor.RGB = RGB(220, 220, 220)
                            s.Line.ForeColor.RGB = RGB(150, 150, 150)
                        End If
                        With s.ActionSettings(ppMouseClick)
                            .Action = ppActionNamedSlideShow
                            With .Hyperlink
                                '.Address = 
                                ' Me.Application.ActivePresentation.FullName
                                .SubAddress = CStr(sectionSlides(slideNumber))
                                .Follow
                            End With
                        End With
                        slideNumber = slideNumber + 1
                        If vertical Then
                            top = top + spaceBetweenBullets
                        Else
                            left = left + spaceBetweenBullets
                        End If
                    Next Count
 
                    If vertical Then
                        top = top + spaceBetweenBullets
                    Else
                        left = left + spaceBetweenBullets
                    End If
 
 
                Next sectionLength
                'slide.Shapes("PB").Delete()
                currentSlideNumber = currentSlideNumber + 1
            End If
        Next
    End With
 
    ScreenUpdating(FindWindowHandle(Application)) = True
 
End Sub
 
 
Sub RemoveDetailedProgressBar()
 
    Dim presentation As PowerPoint.presentation
    Set presentation = Application.ActivePresentation
    Dim X As Integer: X = 0
 
    Dim slide As slide
 
    With presentation
        For Each slide In .Slides
            For X = 0 To slide.Shapes.Count
                On Error Resume Next
                'Debug.Print slide.Shapes.Count
                Debug.Print slide.Shapes(X).Name
                slide.Shapes("PB_" & CStr(X)).Delete
            Next
        Next
    End With
End Sub