Sample Your System Fonts





Sample Your System Fonts

figs/moderate.gif figs/hack15.gif

Your system probably offers more than 100 fonts. How do you choose the right one? If you rely on simple trial and error, you'll quickly find yourself frustrated. Instead, use this hack to get a sample of every available font.

They say there's no accounting for taste, and that's certainly true about fonts. With hundreds of fonts coming preinstalled on most computers, and thousands more available for purchase online, there's something for everybody.

The tried-and-true method of choosing a font in Word is to select some text and then scroll through the Font pull-down menu on the Formatting toolbar until something strikes your fancy. But when you can see only about a dozen fonts at a time, as in Figure, it's hard to compare all your options.

It's difficult to compare over 100 fonts when you can see only 12 at a time
figs/wrdh_0304.gif


You can stop Word from displaying your most recently used fonts at the top of the font list. Open up the Windows registry and find the following registry key:

HKEY_CURRENT_USER\Software\Microsoft\Office\Version\Word\Options

Add a new String value (EditNew) named NoFontMRUList and give it a value of 1.


Word includes a built-in Font menu, but it's not part of the main menu bar by default. To view it, select ToolsCustomize, click the Commands tab, and select "Built-in Menus" from the Categories list. In the Commands section, select the Font menu and drag it to your main menu bar.

You can scroll through the font menu as described above, but a more efficient, more organized, and more fruitful method of comparing your fonts would be to generate a table of some sample text, formatted in each of the available fonts on your system.

This hack creates a new document containing a two-column table with a row for each available font. The first column lists the font's name, and the second column provides some sample formatted text. The macro sorts the font names alphabetically. A portion of the results is shown in Figure.

Font sampler output
figs/wrdh_0305.gif


If you have a large number of fonts installed, this macro could take a few moments to run.

1 The Code

The new document this macro creates will be based on the Normal template, and the font names will be displayed in Times, a standard font nearly guaranteed to be on any computer.

Put the following code in the template of your choice [Post #50] :

Sub FontSampleTable( )

Dim vFontName As Variant

Dim iFontCount As Integer

Dim i As Integer

Dim tbl As Table

Dim sSampleText As String

Dim doc As Document

Dim rng As Range



sSampleText = "abcdefghijklmnopqrstuvwxyz"

sSampleText = sSampleText & Chr$(32) & UCase(sSampleText)

sSampleText = sSampleText & Chr$(32) & "0123456789"

sSampleText = sSampleText & Chr$(32) & ",.:;!@#$%^&*( )"

Application.ScreenUpdating = False



Set doc = Documents.Add

iFontCount = Application.FontNames.Count



Set rng = doc.Range

rng.Font.Name = "Times"

rng.InsertAfter ("Font Name" & vbTab & "Sample" & vbCr)

i = 1

For Each vFontName In Application.FontNames

    StatusBar = "Preparing Sample " & i & " of " & _

                iFontCount & " available fonts: " & vFontName

    rng.Collapse wdCollapseEnd

    rng.InsertAfter (vFontName & vbTab & sSampleText & vbCr)

    rng.Font.Name = vFontName

    i = i + 1

Next vFontName



StatusBar = "Formatting Sample Table ... Please Wait"



doc.Content.ConvertToTable Format:=wdTableFormatWeb1

Set tbl = doc.Tables(1)



tbl.Rows.First.Range.Font.Bold = True

tbl.Rows.First.HeadingFormat = True

tbl.Columns.First.Select



Selection.Font.Name = "Times"

Selection.Rows.AllowBreakAcrossPages = False

Selection.Collapse wdCollapseStart



tbl.SortAscending



StatusBar = "Done"

Application.ScreenUpdating = True

End Sub

To help speed things along, this macro takes advantage of Word's ScreenUpdating property. If you set it to False at the start of the macro, Word will not waste valuable CPU resources constantly redrawing the display. While screen updating will automatically resume once the macro finishes, it's considered good form to explicitly restore it at the end of your code.

Because this macro may take a few minutes to run on a computer with a lot of fonts installed, you can use the StatusBar property to report on the code's progress [Post #65] . The status bar provides meaningful user feedback, particularly if the macro takes time to run. Setting the ScreenUpdating property to False will not affect the status bar.

2 Hacking the Hack

With a few modifications, the generated table can use selected text instead of arbitrary sample characters. This trick is especially useful if your text contains symbols or special characters that may not be defined in certain typefaces, as in the case of the Harrington font, shown in Figure.

Seeing samples of special characters can help you narrow the choices among fonts on your system
figs/wrdh_0306.gif


The following code is a variation of the FontSampleTable macro shown above. With this version, the macro uses the currently selected text as the sample text for each font. If you select more than one paragraph, it uses only the text in the first paragraph.

Sub FontSamplesUsingSelection( )

Dim sel As Selection

Dim vFontName As Variant

Dim iFontCount As Integer

Dim i As Integer

Dim tbl As Table

Dim sSampleText As String

Dim doc As Document

Dim rng As Range



Set sel = Selection

If sel.Characters.Count >= sel.Paragraphs.First.Range.Characters.Count Then

    sSampleText = sel.Paragraphs.First.Range.Text

    ' Need to strip off the trailing Paragraph mark

    ' for the table to generate properly

    sSampleText = Left$(sSampleText, Len(sSampleText) - 1)

Else

    sSampleText = sel.Text

End If

Application.ScreenUpdating = False



Set doc = Documents.Add

iFontCount = Application.FontNames.Count



Set rng = doc.Range

rng.Font.Name = "Times"

rng.InsertAfter "Font Name" & vbTab & "Sample" & vbCr

i = 1

For Each vFontName In Application.FontNames

    StatusBar = "Preparing Sample " & i & " of " & iFontCount & _

    " available fonts: " & vFontName

    rng.Collapse wdCollapseEnd

    rng.InsertAfter vFontName & vbTab & sSampleText & vbCr

    rng.Font.Name = vFontName

    i = i + 1

Next vFontName



StatusBar = "Formatting Sample Table ... Please Wait"



doc.Content.ConvertToTable Format:=wdTableFormatWeb1

Set tbl = doc.Tables(1)



tbl.Rows.First.Range.Font.Bold = True

tbl.Rows.First.HeadingFormat = True

tbl.Columns.First.Select



Selection.Font.Name = "Times"

Selection.Rows.AllowBreakAcrossPages = False

Selection.Collapse wdCollapseStart



tbl.SortAscending



StatusBar = "Done"

Application.ScreenUpdating = True

End Sub


     Python   SQL   Java   php   Perl 
     game development   web development   internet   *nix   graphics   hardware 
     telecommunications   C++ 
     Flash   Active Directory   Windows