Dim Sigles
'/// Cette Sub est à renseigner selon vos sigles et leur correspondance ///
'/// Inscrire d'abord le sigle (ex : "DRH / SMAT") puis sa correspondance ///
'/// (ex : "Département Ressources Humaines, Service Maladie et Accidents de Travail" ///
Sub InitSigles(Optional dummy As Byte)
Sigles = Array("DRH / SMAT", "Département Ressources Humaines, Service Maladie et Accidents de Travail", _
"PMO", "Programmation Microsoft Office", "S1_A", "Service 1 Alimentation")
End Sub
'////////////////////////////////////////////////////////////////////////////////////////
Public Sub CorrespondancesSigles()
Dim A$
Dim Ref$
Dim x%
Dim i&
Dim j&
Dim k&
Dim bool
Call InitSigles
For i& = 0 To UBound(Sigles) - 1 Step 2
ActiveDocument.Content.Select
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
If .Execute(FindText:=Sigles(i&)) Then
Ref$ = ""
A$ = Sigles(i&)
For j& = 2 To Len(A$)
x% = Asc(Mid(A$, j&, 1))
bool = False
If x% >= 48 And x% <= 57 Then bool = True
If x% >= 65 And x% <= 90 Then bool = True
If x% >= 97 And x% <= 122 Then bool = True
If bool Then Ref$ = Ref$ & Mid(A$, j&, 1)
Next j&
A$ = Sigles(i& + 1)
Selection = A$
Selection.Characters(1).Font.Bold = True
For j& = 2 To Len(A$)
If Mid(A$, j& - 1, 1) = Space(1) Then
If UCase(Mid(A$, j&, 1)) = UCase(Mid(Ref$, 1, 1)) Then
Selection.Characters(j&).Font.Bold = True
Ref$ = Mid(Ref$, 2)
End If
End If
Next j&
End If
End With
Next i&
End Sub