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:
-
First, it declares two String variables, one to store the current font name and the other to store the sample text string.
-
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. -
Next, the macro creates a new document (
Documents.Add) and uses aFor... Nextloop that runs once for each font (i.e., for each item in theFontNamescollection). 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. -
The macro then selects all the content of the document and sorts it alphabetically by paragraph.
-
The
With Selection.Findstructure 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." TheExecutecommand 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. -
The three
Selectionstatements 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. -
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
