WD97: Macro para gerar lista de fontes disponíveis no Word

   Sub ListFonts()
      Dim varFont As Variant
      ' Speeds macro processing and suppresses display.
      Application.ScreenUpdating = False
      ' Create new document.
      Documents.Add Template:="normal"
      ' Loop through each available font.
      For Each varFont In FontNames
         With Selection
            ' Format for name of font.
            .Font.Name = "times new roman"
            .Font.Bold = True
            .Font.Underline = True
            ' Insert Font name.
            .TypeText varFont
            ' Insert a new paragraph after the Font Name.
            .InsertParagraphAfter
            ' Move to the new paragraph.
            .MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
            ' Format for the font example.
            .Font.Bold = False
            .Font.Underline = False
            .Font.Name = varFont
            ' Enter example text(Alphabetic characters.)
            .TypeText "abcdefghijklmnopqrstuvwxyz"
            ' Insert a new paragraph.
            .InsertParagraphAfter
            ' Move to the new paragraph.
            .MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
            ' Insert example text(Numeric characters.)
            .TypeText "0123456789?$%&()[]*_-=+/<>"
            ' Insert two new paragraphs and move down.
            .InsertParagraphAfter
            .InsertParagraphAfter
            .MoveDown unit:=wdParagraph, Count:=1, Extend:=wdMove
         End With
      Next varFont
      Application.ScreenUpdating = True
   End Sub