pu78tfx/pOffice
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Téléverser les fichiers vers "/"

Browse Source 
Les fichiers ici présents ont été réalisés pour faire une barre de progression sur PowerPoint adaptée au nombre de diapositives.
This commit is contained in:
William Lonfat 2025-01-05 17:59:42 +01:00
commit 3d0e3306c9
2 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Barre-de-progression.bas Normal file
View File

@ -0,0 +1,17 @@
Attribute VB_Name = "Module1"
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

15
BarreDeProgressionMacro_Corrected.txt Normal file
View File

@ -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