macro_sommaire automatique_comment y insérer les n° de slides
Aucune réponse
standarmaniac
Bonjour,
J'ai la macro pour faire un sommaire automatique en slide 1.
Mais je ne trouve pas la macro pour y inscrire devant chaque titre son numéro de slide correspondant.
A tout hasard, voici ma macro (pour info, j'ai désactivé le dernier § qui dupliquait le sommaire sur tous les slides)
Si qlq'un a une idée :
Public Sub TableMatiere()
' déclaration des variables
Dim sld As Slide
Dim shp As Shape
Dim strTable As String
Dim rgeSommaire As TextRange
Dim i As Integer
' on parcourt les diapos pour récupérer les informations des titres
For i = 2 To ActivePresentation.Slides.Count
Set sld = ActivePresentation.Slides(i)
' on test s'il y a une zone de titre
If sld.Shapes.HasTitle Then
strTable = strTable & vbCrLf & sld.Shapes.Title.TextFrame.TextRange.Text
End If
Next i
' on supprime dans chaque slides 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(1)
Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 100, ActivePresentation.PageSetup.SlideHeight / 2)
With shp
.Name = "TableMatiere"
.TextFrame.TextRange.Text = strTable
End With
' ajout des liens hypertexte (on va parcourir les slides et chercher dans la table des matières les textes)
For i = 2 To ActivePresentation.Slides.Count
Set sld = ActivePresentation.Slides(i)
If sld.Shapes.HasTitle Then
' on cherche dans la table des matières la ligne correspondante
Set rgeSommaire = ActivePresentation.Slides(1).Shapes("TableMatiere").TextFrame.TextRange.Find(sld.Shapes.Title.TextFrame.TextRange.Text)
' on affecte à cet sur le click souris le lien hypertexte
rgeSommaire.ActionSettings(ppMouseClick).Hyperlink.SubAddress = sld.SlideID & "," & sld.SlideIndex & "," & sld.Shapes.Title.TextFrame.TextRange.Text
End If
Next i
' maintenant on recopie cette zone de texte sur chaque sommaire
Set shp = ActivePresentation.Slides(1).Shapes("TableMatiere")
shp.Copy
'For i = 2 To ActivePresentation.Slides.Count
' ActivePresentation.Slides(i).Shapes.Paste
'Next i