Getting a List of Installed FontsYour VBA procedure might need to present the user with a list of fonts to choose from. Or, you may need to determine if a particular font is installed. The simplest way to access the installed font list is to get the fonts from the Font control on the Formatting toolbar. The Font control contains a dropdown list of installed fonts, and you can write VBA code to retrieve that list from the control. Displaying font namesThe 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")
|