Word VBA仅用大写字母替换选择中出现的文本

我的对象很简单-我想要一个快捷方式，用大写字符替换选择中的文本，而不应用“AllCaps”样式，原因我在这里不赘述

我成功地使用了

Selection.Delete

和

Selection.Insert

，但这似乎并没有保留段落样式所固有的字体样式

当我尝试使用VBA

Selection.Find.Execute:=ReplaceAll

时，它正在替换整个文档中的所有实例。我知道这应该是

.wrap=wdFindContinue

的行为，但我已经设置了

.wrap=wdFindStop

。我最好的猜测是，因为我的

.text

被设置为调用

选择

对象的变量，所以在设置

.text

时，它会以某种方式丢失选择（尽管在我逐步执行代码时，这在视觉上并不明显-选择保持高亮显示），导致对整个文档执行

.ReplaceAll

。如果我为特定情况手动输入“find”（

.text

）字符串，它只会在选择上执行（即使在.Replacement.text字段中调用变量

txt

），但显然这不实用

这是我的密码：

Option Explicit
Sub ReplaceWithUppercase()

Dim pasteAutoFormatSetting As Boolean
Dim txt As String
'Save current user selection of whether to adjust spacing automatically when pasting:
pasteAutoFormatSetting = Options.PasteAdjustWordSpacing

'Turn off auto spacing adjustment:
Options.PasteAdjustWordSpacing = False

txt = Selection.Range.text


With Selection.Font
        .AllCaps = False
End With

'The next two lines work but do not seem to preserve built-in font styles
'already applied to the selected text, so I wanted to instead use find/replace:

'Selection.Range.Delete
'Selection.Range.InsertAfter (UCase(txt))


    With Selection.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = txt
        .Replacement.text = UCase(txt)
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

'Return to user preference for auto apacing adjustment:
Options.PasteAdjustWordSpacing = pasteAutoFormatSetting

End Sub

---

使用阵列选择范围和StrConv函数快速工作

Sub ChangeRangeToUCase()
    Const vbUpperCase = 1 ' strConv constant

    Dim arrCells    As Variant
    Dim intRow      As Integer
    Dim intCol      As Integer

    ' Assign Range to an array
    arrCells = Selection
    For intRow = LBound(arrCells, 1) To UBound(arrCells, 1)
        For intCol = LBound(arrCells, 2) To UBound(arrCells, 2)
            arrCells(intRow, intCol) = StrConv(arrCells(intRow, intCol), vbUpperCase)
        Next intCol
    Next intRow

    Selection = arrCells

End Sub

---

@Patentwookie我想你一开始是对的

Selection.Range.Delete
Selection.Range.InsertAfter (UCase(txt))

问题是，一旦删除所选文本，您放置在其位置的任何内容都将采用删除前第一个字符的格式。要解决此问题，您需要：

Option Explicit
Sub ReplaceWithUppercase()
    Selection.Text = UCase(Selection.Text)
End Sub

---

我们只替换所选字符串的大小写，而不是替换实际文本（以及格式），从而使格式保持完整。如果我没看错你的问题，这应该能完全解决你的问题。如果没有，请务必告诉我，我们会解决它。

在宏记录器的帮助下，我们发现：

    Sub ChangeSelectionToUCase()
        ' MsgBox Selection.Range.text
        Selection.Range.Case = wdUpperCase
        ' MsgBox Selection.Range.text
    End Sub

那可以接受吗？看起来确实容易多了。

---

OP担心不使用“AllCapsStyle”。但是使用注释掉的行，我们可以说服自己，文档中的文本确实改为大写，而不仅仅是它的视觉外观（“样式”）。

@Jim_Simson的答案简单明了，但我喜欢看到多种方法。听起来不错-如果你在选择中处理许多单元格，您会发现数组方法几乎是即时的，而不是直接使用选择。谢谢-我会将您的宏复制到我的库中，并注意，对于较大的选择，它的执行速度应该比

selection.Text=someString

快。我喜欢单行宏，谢谢！神秘之处在于，只有当“find”文本是一个选择定义的字符串变量时，您才能对选择执行wdReplaceAll，但您可能永远不需要使用

selection。当您可以只说
selection.text=someString
。PatentWookiee时，您可能就不需要使用
selection.find
。PatentWookiee，不确定这是否响应了您的问题，但是您当然可以使用：
Selection.Text=Replace（“abcdefg”、“cde”、“cde”）
如果您可以使用正则表达式作为Replace函数的参数，那么它将返回“abcdefg”就很好了，但我猜不是在VBA中。我已经编写了使用正则表达式查找和替换文本的宏，但它们相当冗长，也就是说，对于选择中的每个段落：：
。段落txt=para.Range.text'有匹配吗？如果是re.Test（txt），则“get all matches Set allMatches=re.Execute（txt）For Each m In allMatches Debug.Print m.Value num=m.Value+1 Set rng=para.Range rng.collapsestart rng.MoveStart wdCharacter，m.FirstIndex+offset rng.MoveEnd wdCharacter，m.length rng.text=re.Replace（rng.text，num）offset=offset+Len（CStr（num））-Len（m.Value）Next m End如果Next para
手动将光标移动到每个匹配的开始索引（考虑不同长度的先前替换的任何偏移），手动将选择扩展到匹配的末尾，等等。在这种情况下，使用find/replace为我处理这些东西会很好。