如何在 VBA 中的范围/选择中替换 Microsoft Word 字符样式?

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/8748240/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 14:50:51  来源:igfitidea点击:

How can I replace a Microsoft Word character style within a range/selection in VBA?

vbams-wordword-vba

提问by PaulBurton0

I'm working on a Word 2007 template with a macro that will apply character styles to the selected text. It seemed that the Find/Replace feature would be a good place to start, but I think I've found a bug/limitation that prevents the macro from working as desired.

我正在处理带有宏的 Word 2007 模板,该模板将字符样式应用于所选文本。查找/替换功能似乎是一个很好的起点,但我想我发现了一个错误/限制,阻止宏按预期工作。

Here's my vba code:

这是我的 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

If I create a test document that contains a few paragraphs and select a few words in one of the paragraphs, then run the macro, the "Emphasis" style is applied not only to the selection, but beyond the end of the selection to the end of the document.

如果我创建一个包含几个段落的测试文档并在其中一个段落中选择几个单词,然后运行宏,则“强调”样式不仅应用于选择,而且超出选择的结尾到结尾的文件。

This behavior is the same using the actual GUI Find/Replace tool.

使用实际的 GUI 查找/替换工具时,此行为是相同的。

My question is:How can I overcome this bug/limitation and apply the character style ONLYwithin the selection/range?

我的问题是:如何克服此错误/限制并在选择/范围内应用字符样式?

A little more information:
What I really need the macro to do is apply certain formatting to the entire selection while maintaining the existing character styles in the selection. For example, if the selected text contains the Bold character style, the Italic character style, and the rest of it is Default Paragraph Font, the macro should replace Bold with "Revised Bold", replace "Italic" with "Revised Italic", and replace "Default Paragraph Font" with "Revised". That way, when I use the companion macro to "undo" the action of this macro, the original character styles (Bold, Italic, Default Paragraph Font) can be replaced.

更多信息:
我真正需要宏做的是将某些格式应用于整个选择,同时保持选择中的现有字符样式。例如,如果选中的文本包含粗体、斜体,其余为默认段落字体,则宏应将粗体替换为“修订粗体”,将“斜体”替换为“修订斜体”,以及将“默认段落字体”替换为“修订版”。这样,当我使用伴随宏“撤消”该宏的操作时,可以替换原始字符样式(粗体、斜体、默认段落字体)。

SOLVED:
Here is the solution I finally arrived at:

已解决:
这是我最终得出的解决方案:

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

采纳答案by Justin Self

To answer your direct question

回答你的直接问题

My question is: How can I overcome this bug/limitation and apply the character style ONLY within the selection/range?

我的问题是:如何克服此错误/限制并仅在选择/范围内应用字符样式?

Does this not meet the need?:

这不满足需要吗?:

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

EDIT:

编辑:

Ok, based on your comment, what about something like:

好的,根据您的评论,例如:

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

.Words will break up each word in the range into a collection of ranges. Then you can perform styling on each individual word based on its current style.

.Words 会将范围内的每个单词分解为范围的集合。然后,您可以根据每个单词的当前样式对每个单词进行样式设置。

回答by Marcel

I had a slightly different problem and solved it without resorting to a loop. The code works NOT for text which is formatted directly, but it does work for text which is formatted with character styles.

我遇到了一个稍微不同的问题,并在不求助于循环的情况下解决了它。该代码不适用于直接格式化的文本,但它适用于使用字符样式格式化的文本。

Consider a part of the text being selected, either including or not including strings to which already some character style has been assigned.

考虑选择文本的一部分,包括或不包括已经分配了某种字符样式的字符串。

If within the selected range no character style has been assigned yet, after the search the start of the selection won't be the same. If however at least one character style has been assigned the start of the selection will be the same as before the search. Now you can treat those two cases separately. In both cases all characters within the selection to which no character style had been assigned previously will now be linked to "myStyle".

如果在所选范围内尚未分配字符样式,则搜索后选择的开始将不相同。但是,如果至少分配了一种字符样式,则选择的开始将与搜索之前相同。现在您可以分别处理这两种情况。在这两种情况下,之前没有分配字符样式的选择中的所有字符现在都将链接到“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