Tom’s Tutorials For Excel: Listing and Verifying Fonts

Tom’s Tutorials For Excel: Listing and Verifying Fonts

While you can press Alt+O+E to call the Format Cells dialog box and see what fonts are available, with the below macro named ListFonts you can see your fonts on a worksheet all at once, formatted as their font names. The other macro named VerifyFont helps you determine if the font name you’re inquiring about is loaded onto your system’s Excel application.



The two “VerifyFont” macros are identical except that the second one tells you which cell in the list holds the font name you are searching. Note the (0, 0) notation in the code which removes the absolute $ symbols from the cell address, helping the message be a little more reader-friendly.

Option Compare Text

Sub ListFonts()
Application.ScreenUpdating = False
Dim cbc As CommandBarControl, i%
Set cbc = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cbc.ListCount
With Cells(i, 1)
.Value = cbc.List(i)
.Font.Name = cbc.List(i)
End With
Next i
Columns(1).AutoFit
Set cbc = Nothing
Application.ScreenUpdating = True
End Sub




Private Sub VerifyFont()
Dim myFont$
myFont = InputBox("Enter font name:", "Font type installed?")
If myFont = "" Then Exit Sub
Dim cbc As CommandBarControl, i%
Set cbc = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cbc.ListCount
If myFont = cbc.List(i) Then
MsgBox "Yes, the font ''" & myFont & "'' is installed.", 64, "Verified."
Exit Sub
Exit For
End If
Next i
MsgBox "No, the font ''" & myFont & "'' is NOT installed.", , "Missing."
End Sub




Sub VerifyFontListed()
Dim myFont$
myFont = InputBox("Enter font name:", "Font type installed?")
If myFont = "" Then Exit Sub
Dim cbc As CommandBarControl, i%
Set cbc = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cbc.ListCount
If myFont = cbc.List(i) Then
MsgBox "Yes, the font ''" & myFont & "'' is installed." & vbCrLf & _
"See it in cell " & Cells(i, 1).Address(0, 0) & ".", 64, "Verified."
Exit Sub
Exit For
End If
Next i
MsgBox "No, the font ''" & myFont & "'' is NOT installed.", , "Missing."
End Sub