Sub Compter()
count = 0
searchtext$ = InputBox$("Entrer le mot à compter :")
With ActiveDocument.Content.Find
Do While .Execute(FindText:=searchtext$, Format:=False, MatchCase:=False, MatchWholeWord:=True) =True
count = count + 1
Loop
End With
MsgBox searchtext$ & " a été trouvé " & count & " fois"
End Sub

Autre solution :

Cette macro fonctionne à partir de chaînes de caractères. Le compte est égal à la variable "ctr".

Public Sub Occurr()
ActiveDocument.Select
Datext = Selection.Text
Selection.Collapse Direction:=wdCollapseBegin
'Dasearch est la chaîne de caractères à trouver.
Dasearch = "???????"
ctr = 0
Pos = 0
Do
Pos = InStr(1, Datext, Dasearch, 1)
'Chaîne non trouvée.
If Pos = 0 Then
Exit Do
End If
'ctr = nombre d'occurrences
ctr = ctr + 1
Datext = Right(Datext, Len(Datext) - Pos)
Loop While (ctr > 0 And Len(Datext) > Len(Dasearch))
MsgBox ctr
End Sub