Word/Excel VBA中如何以Courier New字体输入字符█并解决字体异常

问题描述 #

1. 在Word的VBA中，如何以Courier New字体输入字符█？
2. 在启用Word模块的Excel VBA中，已设置Font.Name = "Courier New"，但字符█（U+2588）被自动应用Font.NameFarEast属性，显示为等线字体；手动设置.Font.NameFarEast = "Courier New"会触发错误5844（远东字体不存在），如何修正该行为？

用户提供的Excel 2016示例代码：

Option Explicit

Sub Export()
    Dim objWord As New Word.Application
    Dim objDocument As Document

    Set objDocument = objWord.Documents.Add
    objDocument.Content.InsertAfter "test"  'Will be Courier New
    objDocument.Content.InsertAfter ChrW(&H2588)  'Will be DengXing

    With objDocument
        With .Content
            .Font.Name = "Courier New"
            '.Font.NameFarEast = "Courier New"  'Error 5844 (i.e. "FarEast font does not exists")
        End With
        .SaveAs Filename:=CurDir() & "\Sample.docx"
    End With

    objDocument.Close SaveChanges:=wdSaveChanges
    objWord.Quit
    Debug.Print "Done"
End Sub

核心原因 #

█（U+2588）属于Unicode方块字符，Office VBA会根据系统语言环境，将这类字符归类为「远东字符」，自动调用NameFarEast字体属性。而Courier New并非远东字体，因此直接设置NameFarEast会触发字体不存在的错误。

解决方案 #

方案1：单独设置目标字符的字体属性 #

插入字符后，通过Range对象单独指定字体，并清空NameFarEast属性，强制Office使用非远东字体逻辑：

Option Explicit

Sub Export()
    Dim objWord As New Word.Application
    Dim objDocument As Document
    Dim targetRange As Range

    Set objDocument = objWord.Documents.Add
    ' 插入普通文本
    objDocument.Content.InsertAfter "test"
    
    ' 定位到文档末尾，插入目标字符并设置字体
    Set targetRange = objDocument.Content
    targetRange.Collapse Direction:=wdCollapseEnd
    targetRange.Text = ChrW(&H2588)
    targetRange.Font.Name = "Courier New"
    targetRange.Font.NameFarEast = "" ' 清空远东字体关联

    ' 统一设置整个文档内容的字体
    With objDocument.Content.Font
        .Name = "Courier New"
        .NameFarEast = ""
    End With

    objDocument.SaveAs Filename:=CurDir() & "\Sample.docx"

    objDocument.Close SaveChanges:=wdSaveChanges
    objWord.Quit
    Debug.Print "Done"
End Sub

方案2：临时修改Word编辑语言（批量场景适用） #

通过临时将Word的编辑语言切换为非远东语言（如英语），让Office将所有字符按非远东逻辑处理：

Option Explicit

Sub Export()
    Dim objWord As New Word.Application
    Dim objDocument As Document
    Dim originalLang As Long

    ' 保存原编辑语言设置
    originalLang = objWord.LanguageSettings.LanguageID(wdLanguageIDContent)
    ' 临时切换为英语（非远东语言）
    objWord.LanguageSettings.LanguageID(wdLanguageIDContent) = wdEnglishUS

    Set objDocument = objWord.Documents.Add
    objDocument.Content.InsertAfter "test" & ChrW(&H2588)
    objDocument.Content.Font.Name = "Courier New"

    objDocument.SaveAs Filename:=CurDir() & "\Sample.docx"

    ' 恢复原语言设置
    objWord.LanguageSettings.LanguageID(wdLanguageIDContent) = originalLang

    objDocument.Close SaveChanges:=wdSaveChanges
    objWord.Quit
    Debug.Print "Done"
End Sub

针对Word独立VBA的简化方案 #

在Word自身VBA中，直接通过Range对象插入并设置字体即可：

Sub InsertBlockChar()
    Dim targetRange As Range
    Set targetRange = ActiveDocument.Content
    targetRange.Collapse wdCollapseEnd
    targetRange.Text = ChrW(&H2588)
    targetRange.Font.Name = "Courier New"
    targetRange.Font.NameFarEast = ""
End Sub

关键说明 #

• 清空Font.NameFarEast属性会让Office放弃远东字体逻辑，转而使用Font.Name指定的字体。
• 临时修改编辑语言适合批量处理大量字符的场景，避免逐个设置字符属性。
• Courier New原生支持U+2588字符的显示，只要不触发远东字体逻辑即可正常渲染。

内容的提问来源于stack exchange，提问作者The unknown