Bonjour à tous,

premier post sur ce forum pour moi !

J'ai cherché pendant quelque temps (peut être mal cherché ?) et je n'ai pas trouvé de solution qui fonctionne bien pour mettre dans mon en-tête de document Word un breadcrumb, ou fil d'ariane, basé sur les titres de mes paragraphes (listes), breadcrumb comme on peut l'avoir sur beaucoup de sites internet maintenant,et qui permettent de mieux repérer ou l'on se situe dans le site (et donc, dans mon cas, dans le document, assez long et complexe).

Il y a bien le champ {STYLEREF}, mais ça ne fait pas ce que je cherchais exactement.
Il faut l'imbriquer dans des {IF}, créer un style de caractère fictif sans attributs à sur-appliquer sur chaque titre....et ça ne marche pas exactement comme je le voulais...

N'ayant jamais fait de VBA sous word, mon code est peut être un peu barbare, et pas optimisé : merci à ceux qui auraient des idées pour l'améliorer !

Quoiqu'il en soit, j'ai réussi à faire qqchose qui fonctionne, et je pensais que ça pourrait être utile de le partager, étant donné les faibles ressources qu'on trouve sur Internet à ce sujet.

Le principe, basiquement, est de créer ou de mettre à jour, avant chaque enregistrement du document, des variables DOCVARIABLES pour chaque page contenant le breadcrumb à afficher pour la page concernée, accessible via un champ qu'il ne reste plus qu'à mettre dans l'en-tête.

Il faut donc :
  • Créer les variables et les alimenter
  • Mettre le champ dans l'en-tête
  • gérer l'événement BeforeSave


Prérequis :
  • (on peut peut-être s'en passer, mais je n'ai pas cherché, car ce n'était pas mon besoin ici) il faut que les listes des paragraphes soient des listes numérotées du style 1 => 1.1 => 1.1.1 => 1.1.1.1
    Le code peut fonctionner aussi pour des listes sous forme de lettre : il faudra juste adapter un peu...
    Par contre, si elles ne sont pas numérotées, je ne sais pas comment faire...
  • Activer la référence Microsoft Scripting Runtime (pour avoir les dictionnaires, dont je me sers beaucoup...si vous ne voulez pas vous en servir, on peut très certainement travailler avec des collections...je préfère les dictionnaires personnellement.
    Dans l'éditeur VBA, aller dans Outils > Références et activer Microsoft Scripting Runtime


Passons au code :
Dans un module, coller le code suivant :
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
 
Global structure As New Scripting.Dictionary 'contiendra la structure de votre document, structuré dans un dictionnaire pour un accès ultérieur, lors de la construction du breadcrumb, très rapide
Dim X As New Class1 'instanciation de la classe qui permettra de gérer l'événement BeforeSave.
 
Public Sub Register_Event_Handler() 'fonction appelée à l'ouverture du document pour activer le gestionnaire d'événement
Set X.App = Word.Application
End Sub
 
 
Sub Memo_Structure() 'procédure qui mémorise dans mon dictionnaire la struture de votre document
On Error GoTo Gestion_Erreur
Dim item As New Scripting.Dictionary
 
Dim titre1 As String
Dim titre2 As String
Dim titre3 As String
Dim titre4 As String
Dim titre5 As String
 
Dim i As Integer
Dim prgraphe As Variant
Dim titre As String
Set structure = Nothing
For i = 1 To ActiveDocument.ListParagraphs.Count
    titre = Left(ActiveDocument.ListParagraphs(i).Range.Text, Len(ActiveDocument.ListParagraphs(i).Range.Text) - 1)
    Set item = Nothing
 
    Select Case ActiveDocument.ListParagraphs(i).Style
    Case "Titre 1"
        titre1 = titre
        structure.Add titre1, item
    Case "Titre 2"
        titre2 = titre
        structure(titre1).Add titre2, item
    Case "Titre 3"
        titre3 = titre
        structure(titre1)(titre2).Add titre3, item
    Case "Titre 4"
        titre4 = titre
        structure(titre1)(titre2)(titre3).Add titre4, item
    Case "Titre 5"
        titre5 = titre
        structure(titre1)(titre2)(titre3)(titre4).Add titre5, "x"
    End Select
Next i
Gestion_Erreur:
Select Case Err.Number
Case 0, 20
Case Else
    MsgBox Err.Number & " " & Err.Description
    Resume Next
End Select
End Sub
 
Function breadcrumb(niveau_de_liste As String) As String 'fonction qui construit le breadcrumb en fonction du niveau de liste que vous lui passez en argument.
'par exemple, si niveau_de_liste = 4.2.3, le breadcrumb sera construit avec "titre de la section 4" > "titre de la section 4.2" > "titre de la section 4.2.3"
 
Dim niveau() As String
Dim i As Integer
Dim titre1 As String
Dim titre2 As String
Dim titre3 As String
Dim titre4 As String
Dim titre5 As String
 
Dim item As New Scripting.Dictionary
niveau = Split(niveau_de_liste, ".")
 
For i = 0 To UBound(niveau())
    Select Case i
    Case 0
        titre1 = structure.Keys(CInt(niveau(i)) - 1)
        breadcrumb = titre1
    Case 1
        Set item = structure(titre1)
        titre2 = item.Keys(CInt(niveau(i)) - 1)
        breadcrumb = breadcrumb & " > " & titre2
    Case 2
        Set item = structure(titre1)(titre2)
        titre3 = item.Keys(CInt(niveau(i)) - 1)
        breadcrumb = breadcrumb & " > " & titre3
    Case 3
        Set item = structure(titre1)(titre2)(titre3)
        titre4 = item.Keys(CInt(niveau(i)) - 1)
        breadcrumb = breadcrumb & " > " & titre4
    Case 4
        Set item = structure(titre1)(titre2)(titre3)(titre4)
        titre5 = item.Keys(CInt(niveau(i)) - 1)
        breadcrumb = breadcrumb & " > " & titre5
    End Select
Next i
End Function
 
Function Position_Dans_Structure() 'Fonction qui créé les variables BreadcrumbX ou X est le numéro de page
On Error GoTo Gestion_Erreur
Dim position As Integer
Dim titre As String
Dim i As Integer
Dim breadcrumb_trouve As Boolean
Dim varRetour As Variant
 
 
Call Memo_Structure
 
Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
Application.ScreenUpdating = False
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of pages") 'on parcours toutes les pages
    'on recherche le n° de paragraphe correspondant à la première ligne de la page
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    position = Selection.Paragraphs.Count
    breadcrumb_trouve = False
    While breadcrumb_trouve = False And position >= 1
'puis on remonte jjusqu'à trouver un paragraphe dont le style correspond à l'arborescence que vous avez utilisez
        Select Case ActiveDocument.Paragraphs(position).Style
            Case "Titre 1", "Titre 2", "Titre 3", "Titre 4", "Titre 5"
                ActiveDocument.Variables.item("BreadCrumb" & i).Delete
                ActiveDocument.Variables.Add Name:="BreadCrumb" & i, Value:=breadcrumb(ActiveDocument.Paragraphs(position).Range.ListParagraphs(1).Range.ListFormat.ListString)
                breadcrumb_trouve = True
            Case Else
            position = position - 1
        End Select
    Wend
    If breadcrumb_trouve = False Then
        ActiveDocument.Variables.item("BreadCrumb" & i).Delete
        ActiveDocument.Variables.Add Name:="BreadCrumb" & i, Value:=" "
    End If
    Selection.GoTo What:=wdGoToPage, Count:=i + 1
    varRetour = Selection.MoveDown
Next i
 
ActiveDocument.Fields.Update
 
Gestion_Erreur:
Select Case Err.Number
Case 0, 20
Case 5825
    Resume Next
Case Else
    MsgBox Err.Number & " " & Err.Description
    Resume Next
End Select
 
End Function
Bien sûr, si votre style de titre ne s'apelle pas Titre 1, Titre 2, etc...il faudra remplacer dans le code toutes les occurences de Titre 1 par le nom du style équivalent à votre titre de niveau 1, Titre 2 pour l'équivalent de votre titre de niveau 2, etc....
Créer ensuite un module de classe, que vous appelerez Class1 et coller le code suivant :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
 
Public WithEvents App As Word.Application
 
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
Call Position_Dans_Structure
End Sub
Ensuite, coller le code suivant dans la partie code de l'objet Word ThisDocument
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
Private Sub Document_Open()
Call Register_Event_Handler
End Sub
Enfin, il ne reste plus qu'à mettre dans votre en-tête le champ suivant :
{ DOCVARIABLE "BreadCrumb{ PAGE }"}
(faites bien CTRL F9 pour insérer le champ PAGE, sinon, ça ne marche pas....en tout cas chez moi !)

Enjoy !
L'Arbalette