使用VBA将文本插入MS Word文档时出现错误的字体

Question

I am trying to create a VBA procedure for MS Word 2010 that helps me set quotation marks in certain places, and do some additional text replacements.

I need Germany style quotation marks (lower 99 at the beginning of quote, upper 66 at the end).

(When typing manually into a document, with language set to German, MS Word automatically replaces upper straight quotation marks (") by the correct German ones. But this is of no use when inserting quotation marks via VBA procedure as this special treatment of quotation marks seems to be triggered only when the straight quotation marks are punched in via keyboard.)

Here is my code:

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

The documents I am working with are usually set in Times New Roman.

Here is the problem: Everything works fine, especially on fresh documents I created on my computer. However, in documents that contain text copy pasted from my colleagues' documents, the quotation marks - Chr(132) - happen to be set in a different font face (Calibri) than the surrounding text (Times New Roman in my case).

Question : How can I programmatically make sure that the quotation marks inserted - Chr(132) - are set in the same type face as the surrounding text (here: Times New Roman).

By the way: I do not understand why this is a problem at all. As the surrounding text is Times New Roman, why is inserted text Calibri out of a sudden? Especially as the other steps (various replacements) are carried out without type faces being changed. Also, I have a couple of other procedures that insert text programmatically, and there is no problem with wrong type faces. It seems, the issue is related especially to those German lower-99-style quotation marks...

Additional information, after more experiments

I tried to circumvent the issue by adding to my procedure, lazily:

Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend

Selection.Font.Name = "Times New Roman"

Selection.MoveRight

which should mark the four characters in questions and assign "Times New Roman" to them. Surprise: the Calibri quotation marks are resilient enough to be not at all affected.

When checking the various styles applied to paragraphs and letters (using the "Style Inspector") I observe that "Calibri" on these quotation marks is stated in the font selector (dropdown) in Word's menu (or do they call it Ribbon now?) solely, however at not a single other place in the Style Inspector or wherever. Simply no "Calibri" stated there. Only in the Ribbon dropdown.

Answer 1

After some additional experimentation (supported by commenter Cindy Meister) I am now able to present the practical solution of the problem, although not the theoretical explanation of its deeper cause .

Here is the practical solution:

In the affected documents, in an earlier step, another procedure had been run that set type face of all paragraphs to "TimesNewRoman" (mind the spelling!). These documents seem to have appeared on my screen and on the screens of my customers over years without any problems just as Times New Roman (but stated as "TimesNewRoman" in the dropdown selector of the Word menu).

However, for reasons I do not really comprehend, Word was not able to apply this "TimesNewRoman" font to the quotation marks that were inserted into the existing text through my new procedure. (Strangely other things I inserted through other procedures did not have this problem, they appeared nicely in the standard type face of the document.)

When the new procedure is executed in a text that is formated as "Times New Roman" (mind the spelling), the problem with programmatically inserted quotation marks appearing in Calibri does not occur.

As as solution I replaced in my formating procedure the "TimesNewRoman" type face by "Times New Roman".

Now I can execute my text replacement procedure with the expected result: nicely formated lower-99-style quotation marks.

The deeper cause... or rather some evidence that may point to it

I have no final opinion here, but so far my impression is that Word somehow by default, when there is a problematic font name ("TimesNewRoman" appears to be a problem), inserts text that comes from VBA procedures as "Calibri". This formating does not appear in the "Style Inspector" and so on. The only place where I saw it being stated was in the dropdown in the menu (Ribbon). And it was not possible to overwrite the Calibri formating programmatically using VBA:

Selection.Font.Name = "Times New Roman"

The Calibri quotation marks simply were immune against this and remained Calibri.

The only way I found to effectively alter the type face of such Calibri quotation marks was assigning a different type face (eg "Times New Roman") manually via the dropdown selector...

Somebody who knows the inner workings of MS Word better may come up with the final explanation of this strange behaviour.

Answer 2

Building on the information posted in @ChristianGeiselmann 's Answer:

TimesNewRoman is a valid font name for some printers and it can be bought. So Word is doing its best to work with the information it's getting and is substituting some other font to display, as best it can. For some reason, this is adding some odd, obscure attributes for "East Asia" to the Word Open XML.

In the Word Open XML the correct character is displayed, but look at how the run is broken up, with remarks about w:hint = East Asia in the code extract, below. If I remove these then write the Word Open XML back into the document I get the correct result.

<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> 

Conclusion: Due to the use of a font name not present on the machine, Word is performing a font substitution that is writing information into the Word Open XML at a very deep level that is not getting eradicated when the font formatting/styles are changed. The only way to completely get rid of it would be to edit the underlying Word Open XML.

Here is some sample code that makes that replacement and re-writes to the document:

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

Answer 3

Provided you can do without direct character formatting and/or are working with character styles, Selection.ClearCharacterDirectFormatting worked for me (Word 2016 / Windows 10) like a charm:

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