Some simple Office VBA code to make a list of all the available fonts on a computer.
It makes a Word table of all the fonts, including sample text like this.
VBA features on show
The code is fairly straight-forward and a simple example of some standard VBA features.
- Make a new blank document
- Make a new table
Set tbl = ActiveDocument.Tables.Add(<range>, <rows>, <columns>)
- Insert text with the
- Apply formatting using
With .. End With.
Most computers have a lot of installed fonts so the code can take many minutes and lockup Word. For testing, use the alternative line starting “
Set tbl = ActiveDocument...." which only shows the first 20 fonts (or however many you want). There’s no need to change the For loop starting line.
Slightly speed up the code by stopping the screen updating. Add
Application.ScreenUpdating = False near the start and crucially
Application.ScreenUpdating = True at the end.
This code lists all fonts on the computer. We have other code to show all fonts in a single document.
Copy the code
Sub ListInstalledFontsInTable() Dim i As Long Dim rng As Range Dim tbl As Table ' Create a new document Documents.Add DocumentType:=wdNewBlankDocument ' Set a range for the new table Set rng = ActiveDocument.Range(0, 0) ' Create a table with as many rows as there are installed fonts ' this line lists all fonts and can take a long time to run Set tbl = ActiveDocument.Tables.Add(rng, Application.FontNames.Count, 3) ' use this for testing, it's faster. Limits the table to first 20 fonts. 'Set tbl = ActiveDocument.Tables.Add(rng, 20, 3) ' Set the headers tbl.Cell(1, 1).Range.Text = "Number" tbl.Cell(1, 2).Range.Text = "Name" tbl.Cell(1, 3).Range.Text = "Sample" ' Populate the table For i = 1 To Application.FontNames.Count tbl.Cell(i + 1, 1).Range.Text = i tbl.Cell(i + 1, 2).Range.Text = Application.FontNames(i) With tbl.Cell(i + 1, 3).Range ' change this line to whatever sample text you want. .Text = "ABCDEFGHIJKLMNOPQRSTUVWXYZ 1234567890" With .Font .Name = Application.FontNames(i) .Size = 12 .Bold = False .Underline = False .Italic = False End With End With Next i ' Autofit the table to contents tbl.AutoFitBehavior wdAutoFitContent End Sub
Copying the code above should work OK in Edge/Chrome browsers.
With Firefox, we’re told there are problems, probably related to the end of line breaks. Make sure that each code line ends with a full line break, if necessary replace each end of line with a press of the ‘Enter’ key.