如何测试是否使用VBA安装了字体？

Question

检查使用VBA安装特定字体的最简单方法是什么？

Answer 1

http://www.vbcity.com/forums/topic.asp?tid=57012
重定向到
http://vbcity.com/forums/t/55257.aspx

此vb6代码与VBA兼容:

Function FontIsInstalled(sFont As String) As Boolean
    '' This reference should already be set by default
    '' Tools > References > OLE Automation
    Dim NewFont As StdFont
    On Error Resume Next
    Set NewFont = New StdFont
    With NewFont
        ' Assign the proposed font name
        ' Will not be assigned if font doesn't exist
        .Name = sFont
        ' Return true if font assignment succeded
        FontIsInstalled = (StrComp(sFont, .Name, vbTextCompare) = 0)
        ' return actual font name through arguments
        sFont = .Name
    End With
End Function

Answer 2

好的，确实如此，我在发布此内容后 30 秒找到了解决方案。尽管在求助于 SO 之前进行了 10 分钟的搜索......

列出已安装的字体

下面列出的过程在活动工作表的 A 列中显示已安装字体的列表。它使用该FindControl方法来定位“格式”工具栏上的“字体”控件。如果未找到此控件（即，它已被用户删除），则会创建临时 CommandBar 并向其中添加 Font 控件。

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

是否安装了字体？

下面的函数使用与 ShowInstalledFonts 过程相同的技术。如果安装了指定的字体，则返回 True。

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

下面的语句演示了如何在 VBA 过程中使用此函数。如果用户的系统包含 Comic Sans MS 字体，则它会在消息框中显示 True。

MsgBox FontIsInstalled("Comic Sans MS")

以上内容最初来自此 URL ，于 2020 年 2 月 5 日从互联网档案馆检索。