Как я могу заменить стиль символов Microsoft Word в пределах диапазона / выделения в VBA?

Question

Я работаю над шаблоном Word 2007 с макросом, который будет применять стили символов к выделенному тексту. Казалось, что функция Find/Replace была бы хорошим началом, но я думаю, что я нашел ошибку / ограничение, которое мешает макросу работать должным образом.

Вот мой код VBA:

Sub restyleSelection()
    Dim r As Range
    Set r = Selection.Range
    With r.Find
        .Style = ActiveDocument.Styles("Default Paragraph Font")
        .Text = ""
        .Replacement.Text = ""
        .Replacement.Style = ActiveDocument.Styles("Emphasis")
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Если я создаю тестовый документ, который содержит несколько абзацев, и выбираю несколько слов в одном из абзацев, а затем запускаю макрос, стиль "Акцент" применяется не только к выделению, но и от конца выделения до конца. документа.

Это поведение то же самое, используя фактический инструмент поиска / замены GUI.

Мой вопрос: как я могу преодолеть эту ошибку / ограничение и применить стиль символов ТОЛЬКО в пределах выделения / диапазона?

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

РЕШИТЬ:
Вот решение, к которому я наконец пришел:

Sub applyNewRevisedText
    Dim r As Range          ' Create a new Range object
    Set r = Selection.Range ' Assign the current selection to the Range
    Dim rng As Range
    For Each rng In r.Words
        Set rngStyle = rng.Style
        Select Case rngStyle
        Case "Bold"
            rng.Style = ActiveDocument.Styles("New/Revised Text Bold")
        Case "Italic"
            rng.Style = ActiveDocument.Styles("New/Revised Text Emphasis")
        Case Else
            rng.Style = ActiveDocument.Styles("New/Revised Text")
        End Select
    Next rng
End Sub

Answer 1

Чтобы ответить на ваш прямой вопрос

Мой вопрос: как я могу преодолеть эту ошибку / ограничение и применить стиль символов ТОЛЬКО в пределах выделения / диапазона?

Разве это не отвечает потребности?

Sub restyleSelection()
    Selection.Style = ActiveDocument.Styles("Emphasis")
End Sub

РЕДАКТИРОВАТЬ:

Хорошо, на основании вашего комментария, что-то вроде:

Dim rng As Range
  For Each rng In Selection.Words
    If rng.Bold 'do something
  Next rng

.Words разбит каждое слово в диапазоне на набор диапазонов. Затем вы можете выполнить стилизацию для каждого отдельного слова на основе его текущего стиля.

Answer 2

У меня была немного другая проблема, и я решил ее, не прибегая к петле. Код работает НЕ для текста, который отформатирован напрямую, но он работает для текста, который отформатирован со стилями символов.

Рассмотрим часть выделенного текста, включающую или не включающую строки, которым уже был назначен некоторый стиль символов.

Если в пределах выбранного диапазона стиль символов еще не был назначен, после поиска начало выбора не будет таким же. Однако, если хотя бы один стиль символов был назначен, начало выделения будет таким же, как и до поиска. Теперь вы можете рассматривать эти два случая отдельно. В обоих случаях все символы в выделении, которым ранее не был назначен стиль символов, теперь будут связаны с "myStyle".

Vst_Style = "myStyle"

ActiveDocument.Bookmarks.Add Name:="Range"
V_BMstart = Selection.Range.Start
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Default Paragraph Font")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles(Vst_Style)
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
End With
Selection.Find.Execute
If Selection.Range.Start <> V_BMstart Then
    Selection.GoTo what:=wdGoToBookmark, Name:="Range"
    Selection.Style = Vst_Style 
Else
    Selection.GoTo what:=wdGoToBookmark, Name:="Range"
    Selection.Find.Execute Replace:=wdReplaceAll 
End If