CHRIS RAE'S VBA PAGES
Routine: | ShowAllFonts |
Description: | Display all the fonts available for use. |
Sub ShowAllFonts()
' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
' Various incarnations by Chris Rae,
' sometime 1997 to 19/5/99.
Const UseFontSize = 18
Dim aFont
Dim LoopThrough As Integer
Documents.Add
With Selection
.Font.Name = "Times New Roman"
.Font.Size = UseFontSize
.TypeText "There are " & FontNames.Count & _
" fonts installed. They are (listed in order that they are displayed in this file) "
End With
For LoopThrough = 1 To FontNames.Count
' All the """""""s look a bit funny but work
Selection.TypeText """" & FontNames(LoopThrough) & """" & _
IIf(LoopThrough = FontNames.Count - 1, " and ", ",")
Next LoopThrough
Selection.TypeText "."
Selection.TypeParagraph
Selection.TypeParagraph
For Each aFont In FontNames
With Selection
.Font.Name = aFont
.TypeText "This a paragraph of example text typed in the "
.Font.Name = "Times New Roman"
.TypeText aFont
.Font.Name = aFont
.TypeText " font, running in Word 97. THIS IS AN EXAMPLE SENTENCE IN CAPITAL LETTERS, JUST AS A BONUS. And - 0 1 2 3 4 5 6 7 8 9 here are some free numbers."
.Font.Bold = True
.TypeText " Here is some text in bold, "
.Font.Bold = False
.TypeText "and "
.Font.Italic = True
.TypeText "here is some text in italics."
.Font.Italic = False
.TypeParagraph
.TypeParagraph
End With
Next aFont
' Jump back to the top
Selection.HomeKey unit:=wdStory
' And pretend that the document is saved already
ActiveDocument.Saved = True
End Sub
You're free to use these routines for anything you want - all I ask is that for commercial use you give me credit somewhere. You may instead want to head back to the index for my Visual Basic for Applications Pages or the main routines archive page.