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

分类:代码, 博客 标签:

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

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

'================================
' VBA中获取已安装字体
'
' http://cnhup.com
'================================
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")


分类:代码, 博客 标签:

发表评论

You must be logged in to post a comment.