使用 VBA 将文本插入 MS Word 文档时出现错误的字体
Wrong type face when inserting text into MS Word document using VBA
我正在尝试为 MS Word 2010 创建一个 VBA 过程，帮助我在某些地方设置引号，并进行一些额外的文本替换。
我需要德国风格的引号（引号开头是小99，结尾是大66）。
（当手动输入文档时，语言设置为德语，MS Word 自动 将上面的直引号 (") 替换为正确的德语引号。但这是通过 VBA 过程插入引号时没有用，因为这种对引号的特殊处理似乎只有在通过键盘输入直引号时才会触发。）
这是我的代码：
Sub SetInPhraseQuotation()
Dim strString As String
'Mark a certain piece of the text
Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
strString = Selection
'Do some replacements in the string that are not of interest here
strString = replace(strString, Left(strString, 1), ":")
'Do some more replacment and add a lower-99-quotation mark
strString = replace(strString, Right(strString, 1), Chr(132) & UCase(Right(strString, 1)))
Selection.TypeText text:=strString
'Same result also when using
'Selection.Range.text = strString
End Sub
我正在使用的文档通常是在 Times New Roman 中设置的。
问题出在这里：一切正常，尤其是我在计算机上创建的新文档。但是，在包含从我同事的文档中粘贴的文本副本的文档中，引号 - Chr(132) - 恰好设置为与周围文本（在我的情况下为 Times New Roman）不同的字体（Calibri）。
问题：如何以编程方式确保插入的引号 - Chr(132) - 设置为与周围文本相同的字体（此处：Times New罗马).
顺便说一句：我完全不明白为什么这是个问题。既然周围的文字是Times New Roman，为什么插入的文字Calibri突然出来了？尤其是在不更改字体的情况下执行其他步骤（各种替换）。此外，我还有一些其他程序可以以编程方式插入文本，而且错误的字体也没有问题。看来，这个问题尤其与那些德语小99风格的引号有关......
更多信息，经过更多实验
我试图通过懒惰地添加到我的程序中来规避这个问题：
Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
Selection.Font.Name = "Times New Roman"
Selection.MoveRight
应该标记问题中的四个字符并分配给它们"Times New Roman"。惊喜：Calibri 引号具有足够的弹性，不会受到任何影响。
检查应用于段落和字母的各种样式（使用 "Style Inspector"）时，我发现这些引号上的 "Calibri" 在 Word 菜单（或他们现在叫它 Ribbon 吗？），但不是样式检查器中的任何其他位置或任何地方。那里根本没有 "Calibri" 说明。仅在功能区下拉列表中。
经过一些额外的实验（得到评论者 Cindy Meister 的支持），我现在能够提出问题的 实际解决方案 ，尽管不是 的理论解释其更深层次的原因。
下面是实用的解决方案：
在受影响的文档中，在较早的步骤中，另一个程序 运行 将所有段落的字体设置为 "TimesNewRoman"（注意拼写！）。这些文档似乎多年来一直出现在我的屏幕和我的客户的屏幕上，没有任何问题，就像 Times New Roman 一样（但在 Word 菜单的下拉选择器中显示为 "TimesNewRoman"）。
但是，由于我不太理解的原因，Word 无法将此 "TimesNewRoman" 字体应用到通过我的新程序插入到现有文本中的引号。 （奇怪的是我通过其他程序插入的其他东西没有这个问题，它们在文档的标准字体中显示得很好。）
在格式为 "Times New Roman"（注意拼写）的文本中执行新过程时，不会出现 Calibri 中出现的以编程方式插入引号的问题。
作为解决方案，我在格式化过程中将 "TimesNewRoman" 字体替换为 "Times New Roman"。
现在我可以执行文本替换过程并获得预期结果：格式良好的 lower-99 风格的引号。
更深层的原因......或者更确切地说，一些可能指向它的证据
我在这里没有最终意见，但到目前为止我的印象是 Word 在默认情况下不知何故，当字体名称有问题时（"TimesNewRoman" 似乎是一个问题），插入来自 VBA 程序为 "Calibri"。这种格式不会出现在"Style Inspector"等。我看到它的唯一地方是在菜单（功能区）的下拉菜单中。并且无法使用 VBA 以编程方式覆盖 Calibri 格式：
Selection.Font.Name = "Times New Roman"
Calibri 引号完全不受此影响，仍然是 Calibri。
我发现有效改变此类 Calibri 引号字体的唯一方法是通过下拉选择器分配不同的字体（例如 "Times New Roman"）手动 ...
更了解 MS Word 内部工作原理的人可能会得出这种奇怪行为的最终解释。
基于@ChristianGeiselmann 的回答中发布的信息：
TimesNewRoman 是某些打印机的有效字体名称，可以购买。因此，Word 正在尽最大努力处理它所获得的信息，并尽其所能地替换一些其他字体来显示。出于某种原因，这为 "East Asia" 添加了一些奇怪的、模糊的属性到 Word Open XML.
在 Word Open XML 中显示了正确的字符，但请看一下 运行 是如何分解的，下面的代码摘录中有关于 w:hint = East Asia 的注释。如果我删除这些然后将 Word Open XML 写回到文档中，我会得到正确的结果。
<w:r><w:t>Test„ wrong</w:t></w:r>
<w:r><w:rPr><w:rFonts w:hint="eastAsia"/></w:rPr><w:t>„</w:t></w:r>
<w:r><w:t xml:space="preserve"> asdf„ ads</w:t></w:r>
<w:r><w:rPr><w:rFonts w:hint="eastAsia"/></w:rPr><w:t>„</w:t></w:r>
<w:r><w:t xml:space="preserve"> font„</w:t></w:r>
结论：由于使用了计算机上不存在的字体名称，Word 正在执行字体替换，将信息写入 Word Open XML 非常深的级别，不会被根除当字体 formatting/styles 改变时。完全摆脱它的唯一方法是编辑底层 Word Open XML.
下面是一些示例代码，用于对文档进行替换和 re-writes：
Sub ReplaceInWordOpenXML()
Dim sWordOpenXML As String, sCleanedXML As String
Dim sFindTerm1 As String
Dim sFindTerm2 As String
Dim bFound As Boolean
Dim findRange As word.Range
Set findRange = ActiveDocument.content
sFindTerm1 = Chr(132)
sFindTerm2 = Chr(147)
With findRange.Find
.MatchWildcards = True
.Text = "(" & sFindTerm1 & ")*(" & sFindTerm2 & ")"
bFound = .Execute
End With
If bFound Then
sWordOpenXML = findRange.WordOpenXML
sCleanedXML = Replace(sWordOpenXML, "w:hint=" & Chr(32) & "eastAsia" & Chr(32), "")
findRange.InsertXML sCleanedXML
End If
End Sub
假设您可以不使用直接字符格式 and/or 使用字符样式，Selection.ClearCharacterDirectFormatting 对我（Word 2016 / Windows 10）很有帮助：
Sub clearDirectFormat()
ActiveDocument.StoryRanges(wdMainTextStory).Select
Selection.ClearCharacterDirectFormatting
Selection.ClearParagraphDirectFormatting
'footnotes and endnotes need to be treated as individual ranges
Dim fn As Footnote, en As Endnote
For Each fn In ActiveDocument.Footnotes
fn.Range.Select
Selection.ClearCharacterDirectFormatting
Selection.ClearParagraphDirectFormatting
Next fn
For Each en In ActiveDocument.Endnotes
en.Range.Select
Selection.ClearCharacterDirectFormatting
Selection.ClearParagraphDirectFormatting
Next en
End Sub
我正在尝试为 MS Word 2010 创建一个 VBA 过程，帮助我在某些地方设置引号，并进行一些额外的文本替换。
我需要德国风格的引号（引号开头是小99，结尾是大66）。
（当手动输入文档时，语言设置为德语，MS Word 自动 将上面的直引号 (") 替换为正确的德语引号。但这是通过 VBA 过程插入引号时没有用，因为这种对引号的特殊处理似乎只有在通过键盘输入直引号时才会触发。）
这是我的代码：
Sub SetInPhraseQuotation()
Dim strString As String
'Mark a certain piece of the text
Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
strString = Selection
'Do some replacements in the string that are not of interest here
strString = replace(strString, Left(strString, 1), ":")
'Do some more replacment and add a lower-99-quotation mark
strString = replace(strString, Right(strString, 1), Chr(132) & UCase(Right(strString, 1)))
Selection.TypeText text:=strString
'Same result also when using
'Selection.Range.text = strString
End Sub
我正在使用的文档通常是在 Times New Roman 中设置的。
问题出在这里：一切正常，尤其是我在计算机上创建的新文档。但是，在包含从我同事的文档中粘贴的文本副本的文档中，引号 - Chr(132) - 恰好设置为与周围文本（在我的情况下为 Times New Roman）不同的字体（Calibri）。
问题：如何以编程方式确保插入的引号 - Chr(132) - 设置为与周围文本相同的字体（此处：Times New罗马).
顺便说一句：我完全不明白为什么这是个问题。既然周围的文字是Times New Roman，为什么插入的文字Calibri突然出来了？尤其是在不更改字体的情况下执行其他步骤（各种替换）。此外，我还有一些其他程序可以以编程方式插入文本，而且错误的字体也没有问题。看来，这个问题尤其与那些德语小99风格的引号有关......
更多信息，经过更多实验
我试图通过懒惰地添加到我的程序中来规避这个问题：
Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
Selection.Font.Name = "Times New Roman"
Selection.MoveRight
应该标记问题中的四个字符并分配给它们"Times New Roman"。惊喜：Calibri 引号具有足够的弹性，不会受到任何影响。
检查应用于段落和字母的各种样式（使用 "Style Inspector"）时，我发现这些引号上的 "Calibri" 在 Word 菜单（或他们现在叫它 Ribbon 吗？），但不是样式检查器中的任何其他位置或任何地方。那里根本没有 "Calibri" 说明。仅在功能区下拉列表中。
经过一些额外的实验（得到评论者 Cindy Meister 的支持），我现在能够提出问题的 实际解决方案 ，尽管不是 的理论解释其更深层次的原因。
下面是实用的解决方案：
在受影响的文档中，在较早的步骤中，另一个程序 运行 将所有段落的字体设置为 "TimesNewRoman"（注意拼写！）。这些文档似乎多年来一直出现在我的屏幕和我的客户的屏幕上，没有任何问题，就像 Times New Roman 一样（但在 Word 菜单的下拉选择器中显示为 "TimesNewRoman"）。
但是，由于我不太理解的原因，Word 无法将此 "TimesNewRoman" 字体应用到通过我的新程序插入到现有文本中的引号。 （奇怪的是我通过其他程序插入的其他东西没有这个问题，它们在文档的标准字体中显示得很好。）
在格式为 "Times New Roman"（注意拼写）的文本中执行新过程时，不会出现 Calibri 中出现的以编程方式插入引号的问题。
作为解决方案，我在格式化过程中将 "TimesNewRoman" 字体替换为 "Times New Roman"。
现在我可以执行文本替换过程并获得预期结果：格式良好的 lower-99 风格的引号。
更深层的原因......或者更确切地说，一些可能指向它的证据
我在这里没有最终意见，但到目前为止我的印象是 Word 在默认情况下不知何故，当字体名称有问题时（"TimesNewRoman" 似乎是一个问题），插入来自 VBA 程序为 "Calibri"。这种格式不会出现在"Style Inspector"等。我看到它的唯一地方是在菜单（功能区）的下拉菜单中。并且无法使用 VBA 以编程方式覆盖 Calibri 格式：
Selection.Font.Name = "Times New Roman"
Calibri 引号完全不受此影响，仍然是 Calibri。
我发现有效改变此类 Calibri 引号字体的唯一方法是通过下拉选择器分配不同的字体（例如 "Times New Roman"）手动 ...
更了解 MS Word 内部工作原理的人可能会得出这种奇怪行为的最终解释。
基于@ChristianGeiselmann 的回答中发布的信息：
TimesNewRoman 是某些打印机的有效字体名称，可以购买。因此，Word 正在尽最大努力处理它所获得的信息，并尽其所能地替换一些其他字体来显示。出于某种原因，这为 "East Asia" 添加了一些奇怪的、模糊的属性到 Word Open XML.
在 Word Open XML 中显示了正确的字符，但请看一下 运行 是如何分解的，下面的代码摘录中有关于 w:hint = East Asia 的注释。如果我删除这些然后将 Word Open XML 写回到文档中，我会得到正确的结果。
<w:r><w:t>Test„ wrong</w:t></w:r>
<w:r><w:rPr><w:rFonts w:hint="eastAsia"/></w:rPr><w:t>„</w:t></w:r>
<w:r><w:t xml:space="preserve"> asdf„ ads</w:t></w:r>
<w:r><w:rPr><w:rFonts w:hint="eastAsia"/></w:rPr><w:t>„</w:t></w:r>
<w:r><w:t xml:space="preserve"> font„</w:t></w:r>
结论：由于使用了计算机上不存在的字体名称，Word 正在执行字体替换，将信息写入 Word Open XML 非常深的级别，不会被根除当字体 formatting/styles 改变时。完全摆脱它的唯一方法是编辑底层 Word Open XML.
下面是一些示例代码，用于对文档进行替换和 re-writes：
Sub ReplaceInWordOpenXML()
Dim sWordOpenXML As String, sCleanedXML As String
Dim sFindTerm1 As String
Dim sFindTerm2 As String
Dim bFound As Boolean
Dim findRange As word.Range
Set findRange = ActiveDocument.content
sFindTerm1 = Chr(132)
sFindTerm2 = Chr(147)
With findRange.Find
.MatchWildcards = True
.Text = "(" & sFindTerm1 & ")*(" & sFindTerm2 & ")"
bFound = .Execute
End With
If bFound Then
sWordOpenXML = findRange.WordOpenXML
sCleanedXML = Replace(sWordOpenXML, "w:hint=" & Chr(32) & "eastAsia" & Chr(32), "")
findRange.InsertXML sCleanedXML
End If
End Sub
假设您可以不使用直接字符格式 and/or 使用字符样式，Selection.ClearCharacterDirectFormatting 对我（Word 2016 / Windows 10）很有帮助：
Sub clearDirectFormat()
ActiveDocument.StoryRanges(wdMainTextStory).Select
Selection.ClearCharacterDirectFormatting
Selection.ClearParagraphDirectFormatting
'footnotes and endnotes need to be treated as individual ranges
Dim fn As Footnote, en As Endnote
For Each fn In ActiveDocument.Footnotes
fn.Range.Select
Selection.ClearCharacterDirectFormatting
Selection.ClearParagraphDirectFormatting
Next fn
For Each en In ActiveDocument.Endnotes
en.Range.Select
Selection.ClearCharacterDirectFormatting
Selection.ClearParagraphDirectFormatting
Next en
End Sub