Ajouter une barre de progression dans PowerPoint

• Copiez le code ci-dessous dans la zone de texte puis fermer la fenêtre

Sub UpdateProgressBar()
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer
    Dim progressBarName As String
    Dim initialWidth As Single
    Dim progressBar As Shape

    ' Définissez le nom de l'objet que vous souhaitez utiliser comme barre de progression
    progressBarName = "MaBarreDeProgression"

    ' Obtenez la largeur initiale de l'objet sur la dernière diapositive
    For Each shp In ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes
        If shp.Name = progressBarName Then
            initialWidth = shp.Width
            Set progressBar = shp
            Exit For
        End If
    Next shp

    ' Parcourez chaque diapositive
    For i = 1 To ActivePresentation.Slides.Count
        Set sld = ActivePresentation.Slides(i)

        ' Recherchez l'objet par son nom
        Dim found As Boolean
        found = False
        For Each shp In sld.Shapes
            If shp.Name = progressBarName Then
                ' Ajustez la taille de l'objet en fonction de l'avancement dans les diapositives
                shp.Width = initialWidth * (i / ActivePresentation.Slides.Count)
                found = True
            End If
        Next shp

        ' Si l'objet n'est pas trouvé, ajoutez-le
        If Not found Then
            Set shp = sld.Shapes.AddShape(progressBar.AutoShapeType, _
                progressBar.Left, progressBar.Top, _
                initialWidth * (i / ActivePresentation.Slides.Count), progressBar.Height)

            ' Ajustez les propriétés de la barre de progression
            With shp
                .Fill.ForeColor.RGB = progressBar.Fill.ForeColor.RGB
                .Line.Visible = msoFalse
                .Name = progressBarName
            End With
        End If
    Next i
End Sub