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.
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 a
For... Nextloop that runs once for each font (i.e., for each item in the
FontNamescollection). 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.
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." The
Executecommand 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.
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
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 Subupdated