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