如何使用VBA获取已安装字体

VBA编程中，也许会遇到需要显示一个字体列表以供用户选择，或者有时需要检测指定字体是否已安装。这里水文工具集给出一个实用的VBA过程GetInstalledFonts，它通过Excel格式化工具条上的字体控件来获取字体列表。

这一过程主要使用到了FindControl方法，具体代码如下：

'================================
' VBA中获取已安装字体
'
' 
'================================
Sub GetInstalledFonts()
    Set FontList = Application. _
      CommandBars("Formatting"). _
      FindControl(ID:=1728)
    
    If FontList Is Nothing Then
        Set TempBar = Application.CommandBars.Add
        Set FontList = TempBar.Controls.Add(ID:=1728)
    End If
    
    Range("A:A").ClearContents
    For i = 0 To FontList.ListCount - 1
        Cells(i + 1, 1) = FontList.List(i + 1)
    Next i
    
    On Error Resume Next
    TempBar.Delete
End Sub

VBA中检测指定字体是否已安装的函数过程

Function IsFontInstalled(sFont) As Boolean
    IsFontInstalled = False
    Set FontList = Application. _
      CommandBars("Formatting"). _
      FindControl(ID:=1728)
    
    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
            IsFontInstalled = True
            On Error Resume Next
            TempBar.Delete
            Exit Function
        End If
    Next i

    On Error Resume Next
    TempBar.Delete
End Function

使用示例

MsgBox IsFontInstalled("Comic Sans MS")