1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
| Public Sub sommaire()
' déclaration des variables
Dim sld As Slide
Dim sldPrecedente As Slide
Dim shp As Shape
Dim titreSlide As Shape
Dim numDiapo As Shape
Dim strTable As String
Dim strNumDiapo As String
Dim rgeSommaire As TextRange
Dim i As Integer
' on parcourt les diapos pour récupérer les informations des titres
For i = 3 To ActivePresentation.Slides.Count
Set sld = ActivePresentation.Slides(i)
Set sldPrecedente = ActivePresentation.Slides(i - 1)
' on test s'il y a une zone de titre
' on ajoute que celles qui ont un titre différent de la précédente
If sld.Shapes.HasTitle Then
If (sld.Shapes.Title.TextFrame.TextRange.Text <> sldPrecedente.Shapes.Title.TextFrame.TextRange.Text) Then
strTable = strTable & vbCrLf & sld.Shapes.Title.TextFrame.TextRange.Text
strNumDiapo = strNumDiapo & vbCrLf & i
End If
End If
Next i
' on supprime dans chaque slide les zones de texte TableMatiere
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Name = "TableMatiere" Then
shp.Delete
End If
Next shp
Next sld
' on va ajouter le sommaire à la première diapo
Set sld = ActivePresentation.Slides(15)
Set titreSlide = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 200, 20, 400, ActivePresentation.PageSetup.SlideHeight / 2)
Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 100, 600, ActivePresentation.PageSetup.SlideHeight / 2)
' on créé un cadre en plus pour mettre les numéros de diapo
Set numDiapo = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 650, 100, 100, ActivePresentation.PageSetup.SlideHeight / 2)
shp.TextFrame.TextRange.Text = strTable
shp.TextFrame.TextRange.Font.Size = 24
numDiapo.TextFrame.TextRange.Text = strNumDiapo
numDiapo.TextFrame.TextRange.Font.Size = 24
titreSlide.TextFrame.TextRange.Text = "Sommaire"
titreSlide.TextFrame.TextRange.Font.Size = 28
titreSlide.TextFrame.TextRange.Font.Color.RGB = RGB(128, 128, 128)
End Sub |
Partager