Sub ListFonts()
'
' ListFonts Macro
' Lists All Available Fonts
' "&chr(10)&"Macro created 07/10/98 by Trevor Willocks
'
Dim listFont As Variant
    Application.ScreenUpdating = False
    Documents.Add Template:="normal"
    For Each listFont In FontNames
        With Selection
            .Font.Name = "Arial"
            .Font.Size = 12
            .TypeText listFont
            .TypeText Text:=Chr(11)
            .Font.Name = listFont
            .TypeText "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
            .TypeText Text:=Chr(11)
            .TypeText "abcdefghijklmnopqrstuvwxyz"
            .TypeText Text:=Chr(11)
            .TypeText "1234567890 !@#$%^&*()?:"
            .TypeText Text:=Chr(11)
            .InsertParagraphAfter
            .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
        End With
    Next listFont
    Selection.WholeStory
    Selection.Sort
    Selection.HomeKey Unit:=wdStory
    
End Sub

    Source: geocities.com/southbeach/jetty/6744

               ( geocities.com/southbeach/jetty)                   ( geocities.com/southbeach)