je travaille sur une présentation ppt et j'aimerai créer un sommaire automatique qui reprendrais les titres (header) de chaque (y compris les slides d'intercalaire) et mettrait en face les numéros de slide correspondants. j'aimerai aussi que lorsque l'on clique sur un titre dans le sommaire, on soit redirigé vers la slide correspondante, un peu comme sous word ou cela est possible grace au sommaire automatique
Savez vous si il existe un code ou une partie de code duquel je pourrais m'inspirer ?
'boucle sur toutes les diapos à partir de la 2e For y = 2 To ActivePresentation.Slides.Count Set Diapo = ActivePresentation.Slides(y) 'si la diapo a un titre If Diapo.Shapes.HasTitle Then Set titre = Diapo.Shapes.Title texte_ajout = texte_ajout & Format(y, "00 ") & titre.TextFrame.TextRange.Text & Chr(13) End If Next y
J'ai cependant un soucis car j'ai plusieurs titres qui sont identiques sur certaines slides, et j'aimerai que lorsque le titre de la slide N est identique à celui de la slide N-1, il n'y ai pas de ligne rajoutée dans le sommaire,et que cela rajoute juste un intervalle de page (type "p.6 - 10)
Voici le code que j'ai fait avec une pagination qui fonctionne, auriez-vous des solutions à ce problème ?
merci beaucoup !!
Sub sommaire()
Dim Diapo As Slide
Dim titre As Shape
Dim texte_ajout As TextRange
Dim texte_sommaire As TextRange
Dim ligne_sommaire As TextRange
Dim y As Byte
' ajoute une diapo en début de présentation avec
'la disposition de mise en titre n°2 du masque
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
With ActivePresentation.Slides(1)
.Shapes(1).TextFrame.TextRange = "Sommaire"
Set texte_ajout = .Shapes(2).TextFrame.TextRange
End With
'boucle sur toutes les diapos à partir de la 2e
For y = 2 To 23
Set Diapo = ActivePresentation.Slides(y)
'si la diapo a un titre
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte_ajout = texte_ajout & titre.TextFrame. _
TextRange.Text & " (p." & Diapo.SlideNumber & ")" & Chr(13)
End If
Next y
'ajout de liens aux items du sommaire
Set texte_sommaire = _
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
'création liens hypertextes vers les titres
'si vous n'en souhaitez pas supprimez les paragraphes ci dessous
For y = 2 To 23
Set Diapo = ActivePresentation.Slides(y)
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte = titre.TextFrame.TextRange.Text
Set ligne_sommaire = texte_sommaire.Find(FindWhat:=texte)
With ligne_sommaire
.ActionSettings(ppMouseClick).Hyperlink.SubAddress = _
Diapo.SlideID & "," & Diapo.SlideIndex & "," & texte
End With
End If
Next
Sais pas, chez mois pas de probleme, j'ai pris un fichier au hazard et ok. Faudrait votre fichier avec seulement les slides avec les titres si infos confidentielles
Effectivement ce problème semble résolu !
J'ai des difficultés à présent à mettre en forme ce sommaire !
Je voudrais que la pagination apparaissent à la fin de la phrase et soit alignée à droite et également faire apparaitre une tabulation pour les sous parties et les sous sous parties, comme ceci :
1. Introduction p.3
2. XX p.4
3. Accounting principles p.5
3.1 Accounting principles sub part 1 p.6
3.1.1 Accounting principles sub sub part 1 p.7
J'ai déja une idée pour les tabulations je pense qu'on pourrait y arriver avec
si il y a 1 chiffre, pas de tabulation
si il y a 2 chiffres dans le titre, 1 tabulation etc
mais je n'y arrive pas avec la syntaxte VBA ! je n'arrive pas non plus à intégrer toutes les slides dans le sommaire ! j'ai essayé "from 3 to Activepresentation.slides.count" dans la boucle mais le powerpoint plante quand je lance la macro :(
voici mon code :
Sub sommaire()
Dim Diapo As Slide, Diapo1 As Slide
Dim titre As Shape
Dim texte_ajout As TextRange
Dim texte_sommaire As TextRange
Dim ligne_sommaire As TextRange
Dim y As Byte
'Si le titre de la première diapo est "Sommaire", elle sera supprimée
'cela permet de relancer la macro autant de fois que l'on souhaite
'sans avoir à supprimer la diapo de sommaire
If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "Sommaire" Then
ActivePresentation.Slides(1).Delete
End If
' ajoute une diapo en début de présentation avec
'la disposition de mise en titre n°2 du masque
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
With ActivePresentation.Slides(1)
.Shapes(1).TextFrame.TextRange = "Sommaire"
Set texte_ajout = .Shapes(2).TextFrame.TextRange
End With
On Error Resume Next
'boucle sur toutes les diapos à partir de la 2e
For y = 3 To 23
Set Diapo = ActivePresentation.Slides(y)
Set Diapo1 = ActivePresentation.Slides(y + 1)
'si la diapo a un titre
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
Set titre1 = Diapo1.Shapes.Title
If titre.TextFrame.TextRange.Text <> titre1.TextFrame.TextRange.Text Then
texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & Diapo.SlideNumber & ")" & Chr(13)
Else
prem = Diapo.SlideNumber
Cmpt = prem
Do While titre.TextFrame.TextRange.Text = titre1.TextFrame.TextRange.Text
Cmpt = Cmpt + 1
Set Diapo1 = ActivePresentation.Slides(Cmpt)
Set titre1 = Diapo1.Shapes.Title
Loop
texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & prem & " - " & Cmpt - 1 & ")" & Chr(13)
y = Cmpt - 1
End If
End If
Next y
'ajout de liens aux items du sommaire
Set texte_sommaire = ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
'création liens hypertextes vers les titres
'si vous n'en souhaitez pas supprimez les paragraphes ci dessous
For y = 3 To 23
Set Diapo = ActivePresentation.Slides(y)
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte = titre.TextFrame.TextRange.Text
Set ligne_sommaire = texte_sommaire.Find(FindWhat:=texte)
With ligne_sommaire
.ActionSettings(ppMouseClick).Hyperlink.SubAddress = _
Diapo.SlideID & "," & Diapo.SlideIndex & "," & texte
End With
End If
Next
End Sub
Il y a t il un moyen d'envoyer des fichiers via cette plateforme ?
fichier avec tabulation fonction titre. Si possible passer tab a 3 ou 4 caracteres, peut aller. A voir. Probleme avec le deuxieme slide et les deux derniers !!!!!!!!!!!!!!!!!
devrait aller, ai remis le delete du sommaire si present pour eviter la multiplcation des sommaires
Sub sommaireSophie_Grml() Dim Diapo As Slide, Diapo1 As Slide Dim titre As Shape Dim texte_ajout As TextRange Dim texte_sommaire As TextRange Dim ligne_sommaire As TextRange Dim y As Byte
'Si le titre de la première diapo est "Sommaire", elle sera supprimée 'cela permet de relancer la macro autant de fois que l'on souhaite 'sans avoir à supprimer la diapo de sommaire If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "Sommaire" Then ActivePresentation.Slides(1).Delete End If
' ajoute une diapo en début de présentation avec 'la disposition de mise en titre n°2 du masque ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText With ActivePresentation.Slides(1) .Shapes(1).TextFrame.TextRange = "Sommaire" Set texte_ajout = .Shapes(2).TextFrame.TextRange End With
On Error Resume Next
'boucle sur toutes les diapos à partir de la 2e For y = 2 To 23 Set Diapo = ActivePresentation.Slides(y) Set Diapo1 = ActivePresentation.Slides(y + 1)
'si la diapo a un titre If Diapo.Shapes.HasTitle Then Set titre = Diapo.Shapes.Title Set titre1 = Diapo1.Shapes.Title If titre.TextFrame.TextRange.Text <> titre1.TextFrame.TextRange.Text Then texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & Diapo.SlideNumber & ")" & Chr(13) Else prem = Diapo.SlideNumber Cmpt = prem Do While titre.TextFrame.TextRange.Text = titre1.TextFrame.TextRange.Text Cmpt = Cmpt + 1 Set Diapo1 = ActivePresentation.Slides(Cmpt) Set titre1 = Diapo1.Shapes.Title Loop texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & prem & " - " & Cmpt - 1 & ")" & Chr(13) y = Cmpt - 1 End If End If Next y 'ajout de liens aux items du sommaire Set texte_sommaire = ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
'création liens hypertextes vers les titres 'si vous n'en souhaitez pas supprimez les paragraphes ci dessous For y = 2 To 23 Set Diapo = ActivePresentation.Slides(y) If Diapo.Shapes.HasTitle Then Set titre = Diapo.Shapes.Title texte = titre.TextFrame.TextRange.Text Set ligne_sommaire = texte_sommaire.Find(FindWhat:=texte) With ligne_sommaire .ActionSettings(ppMouseClick).Hyperlink.SubAddress = _ Diapo.SlideID & "," & Diapo.SlideIndex & "," & texte End With End If Next End Sub
