获取 VBA Excel 2010 中所有字体的列表答案

【问题标题】：Get a list of all fonts in VBA Excel 2010获取 VBA Excel 2010 中所有字体的列表
【发布时间】：2015-11-11 21:11:34
【问题描述】：

我正在使用 excel VBA，我想在组合框中获取所有字体的列表

谁能帮帮我

我尝试了这段代码，但在 listcount 中出现错误：

...

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

    ' Put the fonts into column A

    *For i = 0 To FontList.ListCount - 1*
        combobox.AddItems  FontList.List(i + 1)
    Next i

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

【问题讨论】：

标签： vba excel

【解决方案1】：

FontList 应该返回一个索引为 1 的列表。不需要从 0 开始。

Dim FontList
Dim i As Long
    
Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)

'Put the fonts into column A
For i = 1 To FontList.ListCount
    Debug.Print FontList.List(i)
    Cells(Rows.Count, 1).End(xlUp)(2) = FontList.List(i)
    'combobox.AddItems FontList.List(i)
    If i > 50 Then Exit For
Next i

这应该在ActiveSheet 的 A 列中构建一个字体列表。当它起作用时，删除评论，使其进入您的组合框。

请注意，您将获得与主页功能区上的字体列表下拉列表完全相同的字体列表。可能会有一些重复，因为该列表在默认标题和正文类别的列表顶部重复了几个字体。

【讨论】：

感谢您的回复，但它无法在 listCount 处抛出相同的错误...对象“-commandbacombobox”的方法 listcount 失败。
如果您想可视化字体，请将其添加到以 "Cells(Rows.Count": Cells(Rows.Count, 1).End(xlUp)(2).Font.Name = FontList.List(i) 开头的行下方

【解决方案2】：

另一种获取字体列表的方法（来自 Word）

Option Explicit

Sub listFonts()
    Dim wd As Object, fontID As Variant

    Set wd = CreateObject("Word.Application")

    For Each fontID In wd.FontNames
        Sheet1.cmbFonts.AddItem fontID
    Next
    wd.Quit
    Set wd = Nothing
End Sub

【讨论】：

可以得到字体的文件名吗？
如果您想获取“云”字体的 TTF 文件名，C:\Users\\AppData\Local\Microsoft\FontCache 中有一个 JSON 格式的字体列表\4\目录 json\ListAll.json。您应该能够解析 JSON 格式的内容并获取这些云字体的名称（TTf 文件名转换为多个数字并放在单独的文件夹中。）