16 lines
830 B
Plaintext
16 lines
830 B
Plaintext
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
|