Discussion :

[raymoundo]

Bonjour,

Mon but est de mettre à gauche de toutes mes diapositives un sommaire qui se met à jour automatiquement quand je change les titres de mes slides.

De plus, j'aimerai qu'il noircisse le titre où qu'il encadre le titre de la diapositive sur laquelle il se trouve.

Je n'arrive pas à générer de table des matières automatique sous powerpoint.
Je pense que cela est réalisable uniquement grâce à une macro!

Quelqu'un à t'il déja fait cela? ou quelqu'un pourrait il m'aider?

J'espère que mes explications n'étaient pas trop flou...

Merci d'avance.

Cordialement,

[Invité]

Bonjour

Il existe un moyen de faire une table des matières (du moins sur PPT 2002, car cela a disparu avec la version 2007, et je n'ai pas la 2003 sous la main).

Cependant, cela crée une diapositive et non un plan inclus dans les diapositives.

Comme tu le dis, à mon avis il va falloir passer par du VBA pour parcourir les slides, interroger les zones de titres (en espérant que ce soit les titres prédéfinis dans les dispositions).

As-tu une zone réservé dans ces slides pour cette table des matières ?

Philippe

[raymoundo]

Oui mon idée serait d'avoir une zone reservée tout à gauche des slides pour le sommaire.

Le titre en haute centré sur le slide.

Sur toutes les diapos nous retrouvons un sommaire et un titre.
Quand on modifie un titre sur une slide, cela modifie le sommaire sur toutes les slides.

Cordialement,

[Sepia]

Salut,


Beaucoup de demandes de ce type, mais toujours pas trouvé de fonction qui rendait ce service dans PPT.

Regarde quand même du côté de l'export de plan vers Word, ça marche pas mal et tu récupères un plan complet.

@+

[Invité]

Bonjour

N'ayant pas beaucoup de temps en ce moment voici un début de piste.

Le code ci-dessous parcourt les slides et récupère ce qu'il y a dans les zones de titres pour créer le sommaire, il crée les liens hypertexte, et mets cela dans chaque slide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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 = 1 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 = 1 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

Deux choses manquent :

Le changement d'aspect visuel de la slide sélectionnée.
La mise à jour à chaque changement de titre (il faut relancer la routine).

Je devrais (en théorie avoir plus de temps pour les jours à venir) pour peaufiner l'ensemble.

Philippe

[Sepia]

On attend avec l'impatience d'un gourmet devant un fraisier

[Mitaka]

Bonjour
j'ai amélioré le script que tu avais mis
j'ai créé une pagination et un titre en plus.
Si la diapo précédente a le même titre que l'actuelle alors on ne l'ajoute pas dans la table des matières. (j'ai appelé plutot ça sommaire)
par contre j'ai pas du tout commenté donc je vous laisserai découvrir par vous même.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
58
 
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(1)
 
 
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

[Sepia]

Salut Mitaka,

Bravo . Il a juste fallu attendre la saison des fraises

[Mitaka]

salut Sepia,
j'ai amélioré le programme,
a présent une diapo est automatiquement créé à la fin d'un document.
s'il y a plus de 13 titres alors il en créé une nouvelle
des traitements spécifiques sont faits propres à mes documents, à chacun de déterminer s'ils sont utiles ou non

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
 Public Sub sommaire()

' déclaration des variables
Dim sld As Slide
Dim titreSlide As String
Dim sldPrecedente As Slide
Dim titreSlidePrecedente As String
Dim shp As Shape
Dim titreSlideSommaire As Shape
Dim numDiapo As Shape
Dim strTable As String
Dim strNumDiapo As String
Dim rgeSommaire As TextRange
Dim i As Integer
Dim countTitre As Integer
Dim titre As String
Dim positionParenthese As Integer


countTitre = 0

' on parcourt les diapos pour récupérer les informations des titres
For i = 2 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
    If (sld.Shapes.HasTitle And sldPrecedente.Shapes.HasTitle) Then
    
        titreSlide = sld.Shapes.Title.TextFrame.TextRange.Text
        titreSlidePrecedente = sldPrecedente.Shapes.Title.TextFrame.TextRange.Text
        
        ' on enlève tout ce qui contient des parenthèses
        positionParenthese = InStr(1, titreSlide, " (")
        If (positionParenthese > 0) Then
            titreSlide = Left(titreSlide, positionParenthese - 1)
        End If
        
        positionParenthese = InStr(1, titreSlidePrecedente, " (")
        If (positionParenthese > 0) Then
            titreSlidePrecedente = Left(titreSlidePrecedente, positionParenthese - 1)
        End If
        
        ' on ajoute que celle qui ont un titre différent de la précédente
        If (titreSlide <> titreSlidePrecedente) Then
            countTitre = countTitre + 1
            If (countTitre > 1) Then
                ' on fait un saut de ligne à la troisième diapo parcourue
                strTable = strTable & vbCrLf
                strNumDiapo = strNumDiapo & vbCrLf
            End If
            ' s'il s'agit d'un sous titre, on met une tabulation
            If (sld.Shapes.Title.TextFrame.TextRange.Characters.Font.Size <= 28) Then
               strTable = strTable & vbTab
            End If
            
            
            ' on enlève les retours à la ligne dans le titre
            titreSlide = Replace(titreSlide, "", " - ") ' petit carré que je ne peux copier 
            
            ' si le titre ou sous-titre dépasse 50 caractères, il va être mis automatiquement à la ligne
            ' il faut donc sauter une ligne dans le shape de numéro de diapo
            ' et donc augmenter le nombre de titres comptabilisés
           
            If (Len(titreSlide) > 50) Then
               strNumDiapo = strNumDiapo & vbCrLf
               countTitre = countTitre + 1
            End If
            
            
            strTable = strTable & titreSlide
            strNumDiapo = strNumDiapo & i
            
        End If
    End If
    ' on met dans un nouveau slide les 13 titres
    If (countTitre = 13) Then
    
        ' on va ajouter le sommaire à la première diapo
        Set sld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
        
        Set titreSlideSommaire = 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éro 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
        
        titreSlideSommaire.TextFrame.TextRange.Text = "Sommaire"
        titreSlideSommaire.TextFrame.TextRange.Font.Size = 28
        titreSlideSommaire.TextFrame.TextRange.Font.Color.RGB = RGB(128, 128, 128)
        
        countTitre = 0
        strTable = ""
        strNumDiapo = ""
    End If
    
Next i


End Sub

pour la saison des fraises, mieux vaut tard que jamais et crosoft n'a toujours pas de solutions !!

Edit : bon je suis un peu hors sujet finalement
parce qu'à la base on voulait un sommaire sur chaque diapo