Sub AjouterBarreDeProgression()
    Dim sld As Slide, shp As Shape
    Dim totalSlides As Integer, currentSlideIndex As Integer, progressWidth As Single
    totalSlides = ActivePresentation.Slides.Count
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Name = "BarreDeProgression" Then shp.Delete
        Next
        currentSlideIndex = sld.SlideIndex
        progressWidth = (currentSlideIndex / totalSlides) * ActivePresentation.PageSetup.SlideWidth
        Set shp = sld.Shapes.AddShape(msoShapeRectangle, 0, ActivePresentation.PageSetup.SlideHeight - 10, progressWidth, 10)
        shp.Fill.ForeColor.RGB = RGB(0, 128, 255): shp.Line.Visible = msoFalse: shp.Name = "BarreDeProgression"
    Next
    MsgBox "Barre de progression ajoutée à toutes les diapositives !"
End Sub