Adaptation Table des Matières VBA Powerpoint

Question

Bonjour à tous,

J'aimerais obtenir une macro dans powerpoint qui permet de créer un "sommaire" automatique (avec liens hypertextes vers les diapos concernées) lors de l'exécution de la macro.
Après plusieurs recherches sur le net je ne parviens pas à trouver ce que je veux, ou plutôt je ne parviens pas à  l'adapter à mon souhait car je ne connais absolument pas le langage VBA.

Voici le code que j'ai trouvé:

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


End Sub

Ce code permet de créer une table des matières sur chaque diapo et dans un petit espace texte sur la gauche, mais je souhaite un sommaire, sur une seule diapo en début de présentation powerpoint.

Si quelqu'un peut m'éclairer ça serait gentil.
Merci

Phiphi41 · Answer

Bonjour

A priori tu as trouvé ce message sur un autre forum, pourquoi ne pas demander sur ce forum à l'auteur de ce code ce qu'il faut faire pour l'adapter.

JustMomotte · Answer

Bonsoir,

Parce que c'est un message qui date de plusieurs années et qu'il est resté sans réponse, de plus la question posée par l'auteur du message n'était pas la même que la mienne.

Cordialement.

Adaptation Table des Matières VBA Powerpoint

2 réponses

Votre réponse

Discussions similaires