Word VBA 用不同格式替换特定格式

Question

在大型Word文档中，我想找到以全部大写字体格式设置的文本实例（即底层字符本身是小写，它们只是显示为大写）并将将这些位转换为实际的大写字符.

在 ChatGPT 的帮助下（我知道......）我可以运行以下脚本，但它不会进入循环：

Sub ConvertToAllCaps()
    Dim rng As Range
    Dim doc As Document
    
    ' Set the document object
    Set doc = ActiveDocument
    
    ' Set the range to search in the entire document
    Set rng = doc.Content
    
    With rng.Find
        ' Set the find parameters
        .Font.AllCaps = True
        
        ' Execute the find operation
        Do While .Execute
            ' Clear formatting before converting to all caps
            rng.ClearFormatting
            ' Convert the found text to all caps
            rng.Case = wdUpperCase
        Loop
    End With
End Sub

此代码在第一次成功转换后停止，即它找到全部大写格式的前 x 个连接的文本位，但随后停止搜索更多此类文本。然后我尝试了在互联网上找到的其他有类似问题的人的许多建议，但没有任何效果。受这个线程的启发，我得到的最接近的是：

Sub ConvertToAllCaps()
    Dim rng As Range
    Dim doc As Document
    Dim bFound As Boolean
    
    bFound = True
    
    ' Set the document object
    Set doc = ActiveDocument
    
    ' Set the range to search in the entire document
    Set rng = doc.Content
    
    rng.Find.ClearFormatting
    Do While bFound
        With rng.Find
        ' Set the find parameters
            .Font.AllCaps = True
 
            rng.ClearFormatting
            rng.Case = wdUpperCase

            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            bFound = .Execute
        End With
    Loop
End Sub

至少这导致 Word 崩溃，所以我知道它进入了循环:) 有什么想法可以修复它吗？

Answer 1

• 您不需要使用

  Do While

  。

  ReplaceAll

  效率更高。

• rng.ClearFormatting

  应该是

  .Replacement.ClearFormatting

  。

微软文档：

Replacement.ClearFormatting 方法（Word）

Find.ClearFormatting 方法（Word）

Font.AllCaps 属性（Word）

Sub ReplaceAllCap()
    With Selection.Find
        .ClearFormatting
        .Font.AllCaps = True
        .Replacement.ClearFormatting
        .Replacement.Font.AllCaps = False
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub