Voici une macro reprise de la KB de Microsoft, et traduite :

Sub ListFonts()
Dim varFont As Variant
Application.ScreenUpdating = False
' Crée un nouveau document sur la base du normal.dot
Documents.Add Template:="normal"
' fait une boucle sur chaque fonte
For Each varFont In FontNames
With Selection
.Font.Name = "times new roman"
.Font.Bold = True
.Font.Underline = True
.TypeText varFont
.InsertParagraphAfter
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
.Font.Bold = False
.Font.Underline = False
.Font.Name = varFont
' entre un exemple de texte (les lettres de l'alphabet)
.TypeText "abcdefghijklmnopqrstuvwxyzéèùîù"
.InsertParagraphAfter
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
' Insérer exemple texte(les caractères numériques)
.TypeText "0123456789?$%&()[]*_-=+/<>"
.InsertParagraphAfter
.InsertParagraphAfter
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
End With
Next varFont
Application.ScreenUpdating = True
End Sub