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 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
| Private Const SeqName As String = "SequenceDeParagraphe"
Sub RemoveParagraphSequence()
' Remove all Fields ParagraphSequence
Dim SeqField As String
Dim CurField As Field
Dim Count As Integer
Dim InitialView As WdViewType
' Switch to Normal view to avoid page number computation during field removal
InitialView = ActiveWindow.View.Type
ActiveWindow.View.Type = wdNormalView
' Loop on document fields
Count = 0
For Each CurField In ActiveDocument.Fields
' Select field of type sequence
If CurField.Type = wdFieldSequence Then
' which code contains SeqName
If InStr(CurField.Code.Text, SeqName) <> 0 Then
CurField.Delete
Count = Count + 1
End If
End If
Next CurField
' Switch to Initial View
ActiveWindow.View.Type = InitialView
Debug.Print ("Nombre de champs séquence supprimés: " & Count)
End Sub
Sub AddParagraphSequence()
' Add a Sequence Field at the beginning of each non-empty paragraph
' of type MonStyleParagraphe given by the user
Dim MonStyleParagraph As String
Dim CurParagraph As Paragraph
Dim Count As Integer
Dim InitialView As WdViewType
Dim Num As Long
MonStyleParagraph = GetStyleName()
If MonStyleParagraph = "" Then
Exit Sub
End If
' Switch to Normal view to avoid page number computation during field insertion
InitialView = ActiveWindow.View.Type
ActiveWindow.View.Type = wdNormalView
' Remove existing ParagraphSequence fields
Call RemoveParagraphSequence
Count = 0
' Loop on paragraphs
For Each CurParagraph In ActiveDocument.Paragraphs
' Select only paragraphs with matching style
If CurParagraph.Style.NameLocal = MonStyleParagraph Then
' Get list value
Num = CurParagraph.Range.ListFormat.ListValue
If Num <> 0 Then
' Add a field at start of current Paragraph
' field is sequence SeqName, \h makes it hidden
' affect listvalue to sequence field
ActiveDocument.Fields.Add Range:=ActiveDocument.Range(CurParagraph.Range.Start, CurParagraph.Range.Start), Type:=wdFieldSequence, Text:=SeqName & " \h" & " \r " & Num, PreserveFormatting:=False
Count = Count + 1
End If
End If
Next CurParagraph
' Display field results
ActiveWindow.View.ShowFieldCodes = False
' Switch to Initial View
ActiveWindow.View.Type = InitialView
MsgBox ("Nombre de champs séquence ajoutés: " & Count)
End Sub
Sub UpdateIndex()
' Update Index to use SeqName sequence number rather than page number
Dim TheCode As String
' Check document has one index
If ActiveDocument.Indexes.Count <> 1 Then
MsgBox ("Erreur: le document contient plusieurs Indexes")
Return
End If
' Add sequence and separator field options if not already there
' \s SEQNAME adds sequence number to page numbers in the index
' \d defines character between sequence number and page number
With ActiveDocument.Indexes(1).Range.Fields(1)
TheCode = .Code.Text
If InStr(TheCode, SeqName) = 0 Then
.Code.Text = TheCode & " \d ""-"" \s " & SeqName & " "
End If
.Update
End With
' Clear page numbers from the index
ActiveWindow.View.ShowFieldCodes = False
With ActiveDocument.Indexes(1).Range
' Replace "-xxxx" into ""
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
With .Find
.Text = "-[0-9][0-9][0-9][0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
.Find.Execute Replace:=wdReplaceAll
' Replace "-xxx" into ""
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
With .Find
.Text = "-[0-9][0-9][0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
.Find.Execute Replace:=wdReplaceAll
' Replace "-xx" into ""
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
With .Find
.Text = "-[0-9][0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
.Find.Execute Replace:=wdReplaceAll
' Replace "-x" into ""
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
With .Find
.Text = "-[0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
.Find.Execute Replace:=wdReplaceAll
End With
End Sub
Function GetStyleName() As String
'Get the name of the style for indexed paragraph
Dim StyleName As String
Dim CurStyle As Style
Dim found As Integer
StyleName = InputBox("Entrer le nom du style des paragraphes à indexer")
found = 0
For Each CurStyle In ActiveDocument.Styles
If CurStyle.NameLocal = StyleName Then
found = 1
Exit For
End If
Next CurStyle
If found = 1 Then
GetStyleName = StyleName
Else
MsgBox ("Erreur: Le style '" & StyleName & "' est inconnu")
GetStyleName = ""
End If
End Function |
Partager