[Breadcrumb ou fil d'ariane] Réaliser un breadcrumb en en-tête
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:
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:
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:
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
