Sub MotsGrasWord()
' ****************************************************
'Nécessite d'activer la référence Microsoft Word xx.x Object Library
' Alt+F11 / Références et cocher la réf dans la liste
' ****************************************************
Dim Fichier As String
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim CollWord As Word.Words
Dim t As Long, u As Integer, MotsenGras As Long
Dim A as string, B as string
Application.ScreenUpdating = False
Fichier = "C:\CHeminduFichier\" & "NomduFichier.doc" 'Adapter le bon chemin et nom de fichier
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False
Set wordDoc = wordApp.Documents.Open(Fichier) 'ouverture Doc word
Set CollWord = wordDoc.Content.Words
For t = 1 To CollWord.Count 'boucle sur les mots du document
A = "!?,.;:()' 1234567890+-*=/€£$%[]" 'Lettres à enlever des mots trouvés pour ne garder que les "vrais" mots et pas prendre en compte les nombres ou les signes de ponctuation qui seraient en gras (probablement oublié qques uns mais le principe est là)
B = CollWord(t)
For u = 1 To Len(A)
B = Replace(B, Mid(A, u, 1), "")
Next u
If Len(Replace(B, Chr(13), "")) > 0 Then
If CollWord(t).Bold = -1 Then MotsenGras = MotsenGras + 1
End If
Next t
wordDoc.Close False 'fermeture documents word
wordApp.Quit
Set wordDoc = Nothing
Set wordApp = Nothing
Set CollWord = Nothing
MsgBox "Il y a " & MotsenGras & " mots en gras dans le document " & Fichier
End Sub