How to test if a font is installed using VBA?

Question

What is the easiest way to check if a particular font is installed using VBA?

Answer 1

OK, true to form I found a solution 30 seconds after posting this. This is despite a 10 minute search before resorting to SO....

List installed fonts

The procedure listed below displays a list of installed fonts in Column A of the active worksheet. It uses the FindControl method to locate the Font control on the Formatting toolbar. If this control is not found (i.e. it was removed by the user) a temporary CommandBar is created and the Font control is added to it.

Sub ShowInstalledFonts()
    Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)

    'If Font control is missing, create a temp CommandBar
    If FontList Is Nothing Then
        Set TempBar = Application.CommandBars.Add
        Set FontList = TempBar.Controls.Add(ID:=1728)
    End If

    'Put the fonts into column A
    Range("A:A").ClearContents
    For i = 0 To FontList.ListCount - 1
        Cells(i + 1, 1) = FontList.List(i + 1)
    Next i

    'Delete temp CommandBar if it exists
    On Error Resume Next
    TempBar.Delete
End Sub

Is a font installed?

The function below uses the same technique as the ShowInstalledFonts procedure. It returns True if a specified font is installed.

Function FontIsInstalled(sFont) As Boolean
    'Returns True if sFont is installed
    FontIsInstalled = False
    Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)

    'If Font control is missing, create a temp CommandBar
    If FontList Is Nothing Then
        Set TempBar = Application.CommandBars.Add
        Set FontList = TempBar.Controls.Add(ID:=1728)
    End If

    For i = 0 To FontList.ListCount - 1
        If FontList.List(i + 1) = sFont Then
            FontIsInstalled = True
            On Error Resume Next
            TempBar.Delete
            Exit Function
        End If
    Next i

    'Delete temp CommandBar if it exists
    On Error Resume Next
    TempBar.Delete
End Function

The statement below demonstrates how to use this function in a VBA procedure. It displays True in a message box if the user's system contains the Comic Sans MS font.

MsgBox FontIsInstalled("Comic Sans MS")

The above was originally at this URL, retrieved from the Internet Archive on 2020-02-05.