Неправильный тип лица при вставке текста в документ MS Word с использованием VBA

Я пытаюсь создать процедуру VBA для MS Word 2010, которая помогает мне устанавливать кавычки в некоторых местах и ​​выполнять некоторые дополнительные замены текста.

Мне нужны кавычки в немецком стиле (ниже 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) - оказываются не такими шрифтами (Calibri), как окружающий текст (Times New Roman в моем случае).

Вопрос: Как программно убедиться, что вставленные кавычки - Chr(132) - установлены в том же шрифте, что и окружающий текст (здесь: Times New Roman).

Кстати: я не понимаю, почему это проблема вообще. Поскольку окружающий текст является 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 достаточно эластичны, чтобы на них вообще не влияли.

При проверке различных стилей, примененных к абзацам и буквам (с помощью "Инспектора стилей"), я замечаю, что "Калибри" на этих кавычках указывается в селекторе шрифта (раскрывающемся списке) в меню Word (или они сейчас называют его "Лента"?) только в другом месте инспектора стиля или где-либо еще. Просто нет "Калибри" там заявлено. Только в раскрывающемся списке ленты.

Источник

2 ответа

Решение

После некоторых дополнительных экспериментов (поддержанных комментатором Синди Мейстер) я теперь могу представить практическое решение проблемы, но не теоретическое объяснение ее более глубокой причины.

Вот практическое решение:

В затронутых документах на более раннем этапе была запущена другая процедура, которая установила лицевой шрифт всех абзацев в "TimesNewRoman" (помните написание!). Эти документы, по-видимому, появлялись на моем экране и на экранах моих клиентов в течение многих лет без каких-либо проблем, как Times New Roman (но в выпадающем списке меню Word указывалось как "Times New Roman").

Однако по причинам, которые я на самом деле не понимаю, Word не смог применить этот шрифт "TimesNewRoman" к кавычкам, которые были вставлены в существующий текст с помощью моей новой процедуры. (Странно, но другие вещи, которые я вставил через другие процедуры, не имели этой проблемы, они красиво выглядели на лицевой стороне документа стандартного типа.)

Когда новая процедура выполняется в тексте, который форматируется как "Times New Roman" (обратите внимание на написание), проблема с программно вставленными кавычками, появляющимися в Calibri, не возникает.

В качестве решения я заменил в моей процедуре форматирования лицо типа "TimesNewRoman" на "Times New Roman".

Теперь я могу выполнить процедуру замены текста с ожидаемым результатом: красиво отформатированные кавычки в стиле нижних 99.

Более глубокая причина... или, скорее, некоторые доказательства, которые могут указывать на это

У меня нет окончательного мнения здесь, но до сих пор у меня сложилось впечатление, что Word каким-то образом по умолчанию, когда есть проблемное имя шрифта ("TimesNewRoman" кажется проблемой), вставляет текст, который приходит из процедур VBA, как "Calibri". Это форматирование не отображается в "Инспекторе стилей" и так далее. Единственное место, где я увидел это, было раскрыто в меню (Лента). И было невозможно перезаписать форматирование Calibri программно с помощью VBA:

Selection.Font.Name = "Times New Roman"

Кавычки Калибри просто были невосприимчивы к этому и оставались Калибри.

Единственный способ эффективно изменить тип лица таких кавычек Calibri - назначить другой тип шрифта (например, "Times New Roman") вручную с помощью выпадающего селектора...

Кто-то, кто лучше знает внутреннюю работу MS Word, может прийти к окончательному объяснению этого странного поведения.

Источник

При условии, что вы можете обойтись без прямого форматирования символов и / или работать со стилями символов, 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
Источник

Основываясь на информации, опубликованной в ответе @ChristianGeiselmann:

TimesNewRoman является допустимым именем шрифта для некоторых принтеров, и его можно купить. Таким образом, Word делает все возможное для работы с получаемой информацией и заменяет какой-либо другой шрифт для отображения, насколько это возможно. По какой-то причине это добавляет некоторые странные, неясные атрибуты для "Восточной Азии" в 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 на очень глубоком уровне, который не уничтожается при изменении форматирования / стилей шрифта. Единственный способ полностью избавиться от этого - отредактировать основной Word Open XML.

Вот пример кода, который выполняет эту замену и перезаписывает документ:

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
Источник
Другие вопросы по тегам