MS Word

Print Samples of Each Font Installed on Your PC

The Problem:

I need a printout of all the fonts that Word can offer me. I'm sick of scrolling through the font list trying to find one that looks okay.

The Solution:

Try the macro shown in Example 8-14.

Here's what the macro does:

  1. First, it declares two String variables, one to store the current font name and the other to store the sample text string.

  2. It then displays an input box prompting the user to enter the sample text string that she wants to use, providing her with default text that she can accept. If the input box returns an empty string (""), the user either clicked the Cancel button, or deleted the default string and failed to replace it. Either way, the macro quits without further ado.

  3. Next, the macro creates a new document (Documents.Add) and uses a For... Next loop that runs once for each font (i.e., for each item in the FontNames collection). The loop resets the font, types the font's name followed by "parahere," applies the font, and types the sample text string. The word "parahere" is a placeholder that enables the macro to separate the font names from the sample text that follows; you can use any other unique text string instead.

  4. The macro then selects all the content of the document and sorts it alphabetically by paragraph.

  5. The With Selection.Find structure clears formatting and options that might cause problems and then performs two replace operations. Some Find properties may already be set in Word, so it's best to clear formatting, specify a zero-length text string, and turn off options such as "Match case," "Use wildcards," and "Find all word forms." The Execute command executes each search. The first replace operation replaces the placeholder text "parahere" with "parahere" and an extra paragraph, which splits each font name from its sample text. The second replace operation replaces "parahere" with a Heading 2 paragraph. This has the effect of applying the Heading 2 style to the paragraphs that contain the font names.

  6. The three Selection statements collapse the selection, apply the Heading 1 style to the first paragraph in the document, and enter a heading for the list in that paragraph.

  7. The message box tells the user what the macro has done and prompts her to save the document if she wants to keep it.

Macro to list all the fonts available to Word, with a sample of each font

Example 8-14.
  Sub List_All_Fonts()
      'Lists all the fonts available to Word with the current printer driver
      Dim strFont As Variant
      Dim strText As String
      strText = InputBox(Prompt:= _
          "Type the sample text you want to use in the font listing:", _
          Title:="List All Fonts", _
          Default:="The five boxing wizards jump quickly.")
      If strText = "" Then Exit Sub
      Documents.Add
      For Each strFont In FontNames
          Selection.Font.Reset
          Selection.TypeText strFont & "parahere"
          Selection.Font.Name = strFont
          Selection.TypeText strText & vbCr
      Next
      ActiveDocument.Content.Select
      Selection.Sort FieldNumber:="Paragraphs", _
          SortFieldtype:=wdSortFieldAlphanumeric
      With Selection.Find
          .ClearFormatting
          .MatchCase = False
          .MatchAllWordForms = False
          .MatchWholeWord = False
          .MatchSoundsLike = False
          .MatchWildcards = False
          .Forward = True
          .Wrap = wdFindContinue
          .Text = "parahere"
          .Replacement.Text = "parahere^p"
          .Execute Replace:=wdReplaceAll
          .Text = "parahere"
          .Replacement.Style = "Heading 2"
          .Execute Replace:=wdReplaceAll
          .Replacement.ClearFormatting
          .Replacement.Text = ""
          .Execute Replace:=wdReplaceAll
          .Text = ""
      End With
      Selection.Collapse Direction:=wdCollapseStart
      Selection.Paragraphs(1).Style = "Heading 1"
      Selection.TypeText "List of Fonts Available to Word"
      MsgBox "The macro has created a list showing the fonts currently " _
         & "available to Word." & vbCr & vbCr & _
        "Please save this document if you want to keep it.", _
        vbOKOnly + vbInformation, "List All Fonts Macro"
    End Sub
by BrainBellupdated
Advertisement: