Actualiser BarreDeProgression.txt

BarreDeProgression.txt

@@ -0,0 +1,15 @@
+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