Sommaire automatique powerpoint 2013

Fermé

Powerpoint
Sommaire

Sophie Grml Messages postés 11 Date d'inscription lundi 18 novembre 2013 Statut Membre Dernière intervention 10 juillet 2014 - 3 juil. 2014 à 14:58
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 10 juil. 2014 à 11:45

Bonjour,

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 ?

merci d'avance !

sophie

Posez votre question

A voir également:

Sommaire dans powerpoint
Sommaire word - Guide
Visionneuse powerpoint - Télécharger - Présentation
Insérer une vidéo dans powerpoint - Guide
Réparer fichier powerpoint endommagé gratuit - Télécharger - Suite bureautique
Repair Powerpoint Presentation - Télécharger - Récupération de données

13 réponses

Réponse 1 / 13

Sophie Grml Messages postés 11 Date d'inscription lundi 18 novembre 2013 Statut Membre Dernière intervention 10 juillet 2014
3 juil. 2014 à 16:01

Bonjour,

Merci beaucoup pour le code, il fonctionne très bien
Est-ce que cela serait possible de rajouter le numéro de slide pour chaque titre du sommaire ?

merci beaucoup !

Réponse 2 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
3 juil. 2014 à 17:54

Re,

Je regarde la chose

A+

Réponse 3 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
3 juil. 2014 à 18:33

Re,

ligne en gras pour index slide

    '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

Réponse 4 / 13

Sophie Grml Messages postés 11 Date d'inscription lundi 18 novembre 2013 Statut Membre Dernière intervention 10 juillet 2014
4 juil. 2014 à 15:21

merci pour vos réponses,

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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 13

Sophie Grml Messages postés 11 Date d'inscription lundi 18 novembre 2013 Statut Membre Dernière intervention 10 juillet 2014
4 juil. 2014 à 16:36

merci beaucoup , ca fonctionne (presque) à merveille, sauf un petit problème de pagination lorsque les titres sont identiques, ca m'affiche ca :

Accounting Manual (p.2)
1. Introduction (p.5)
2. Definitions (p.6)
3. Group accounting policies (p.7 - 8)

(p.9 - 16)
4. Profit and loss account (p.17)
4.1 Income (p.18)
4.1.1.1 Products (p.19)
4.1.1.2 Non-Recurring Engineering (p.20 - 23)

est ce que cela peut etre lié au fait que les titres n'ont pas le meme format ? (taille par ex)

merci beaucoup !!

Réponse 6 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 juil. 2014 à 17:15

Re,

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

Réponse 7 / 13

Sophie Grml Messages postés 11 Date d'inscription lundi 18 novembre 2013 Statut Membre Dernière intervention 10 juillet 2014
9 juil. 2014 à 19:52

Bonjour,

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 ?

merci d'avance !!

Réponse 8 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
10 juil. 2014 à 07:52

Bonjour,

Pour mettre un fichier a dispo, click sur le lien suvant: https://www.cjoint.com/

N'oubliez pas de copier/coller le lien cree dans votre prochain message

A+

Réponse 9 / 13

Sophie Grml Messages postés 11 Date d'inscription lundi 18 novembre 2013 Statut Membre Dernière intervention 10 juillet 2014
10 juil. 2014 à 09:46

merci !

voici le lien :

https://www.cjoint.com/?DGkjSeLOR0a

merci bcp !

Réponse 10 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
10 juil. 2014 à 10:12

Re,

je recupere votre fichier et vous tiens au courant.

A+

Réponse 11 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
10 juil. 2014 à 11:45

Re,

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

https://www.cjoint.com/c/DGklS6KLQyX

pour cadrage num pages, j'attends votre retour sur le fichier

Réponse 12 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 juil. 2014 à 16:11

Bonjour,

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

-1

Réponse 13 / 13

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
3 juil. 2014 à 15:31

Bonjour,

http://fr.viadeo.com/fr/groups/detaildiscussion/?containerId=0021el8i9qpyom60&forumId=0022kc3dpxpaoo2&action=messageDetail&messageId=002umvaexyixkxo

-2

Posez votre question

Discussions similaires

Afficher le plan dans chaque diapositive

Momo34 - 23 août 2015 à 14:00
Raymond PENTIER - 23 août 2015 à 18:37

2 réponses

Sommaire dynamique powerpoint office 365 avec numéro de page liens vers diapos

OHELP - 29 juin 2020 à 16:24
m@rina - 30 juin 2020 à 14:01

1 réponse

créer un sommaire dans powerpoint

judith - 26 juil. 2005 à 17:25
Elvire - 22 août 2017 à 16:56

47 réponses

Rapport : Ne pas Numéroter les 3 premières pages (LIBRE OFFICE)

Utilisateur anonyme - 30 juin 2014 à 14:15
OOoForum - 2 juil. 2014 à 15:08

4 réponses

Sommaire flottant powerpoint 2013

krieger73 - 18 mars 2015 à 14:17
C-Claire - 18 mars 2015 à 16:51

3 réponses

Alignement chiffres à droite table des matières

florydo - 13 mai 2015 à 01:47
florydo - 13 mai 2015 à 08:04

2 réponses

Devenez membre en quelques clics

Connectez-vous simplement avec ceux qui partagent vos intérêts
Suivez vos discussions facilement et obtenez plus de réponses
Mettez en avant votre expertise et aidez les autres membres
Profitez de nombreuses fonctionnalités supplémentaires en vous inscrivant

S'inscrire

Discussions similaires

Newsletters