[PPT-2013] Sommaire vba pagination-tabulation

Bonjour,

Je dois réaliser un sommaire vba sur ppt 2013 mais j'ai qques soucis;

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

voici mon code :

Code:

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

merci par avance pour votre aide,

I.