替换：指定字符原有底纹居然不变

weiyingde

目的：要改变诸如“1 Excelhome_Word”之类文字的底纹，可没有效果，不知何故。
Sub 查找并替换指定字符原有的底纹()
Dim tm As Single
tm = Timer
With ActiveDocument.Content.Find
     .ClearFormatting
     With .Replacement
          .ClearFormatting
         With .Font
          .Name = ""
          .ColorIndex = wdBlack
       '   .Shading.Texture = wdTextureNone
          .Shading.ForegroundPatternColor = wdColorPink
         End With
     End With
     .Execute "[0-9]@ Excelhome_Word", , , 1, , , , , 1, "^&", 2
End With
    MsgBox "Word共用时" & Timer - tm, vbInformation
End Sub

weiyingde

再次求教于大方之家。

weiyingde

大侠路过，请援手，在此恭候，请赐教，先谢了。

weiyingde

再次救助，大侠在线救我，我在线等。

daibao88

循环查找，一次次改底纹试试。

ammyc

底纹好似只有一种颜色，文本突出显示颜色才有多种

weiyingde

两位大侠能否做一个实例，给示范一下？谢谢了

daibao88

ammyc 发表于 2020-1-28 09:45
底纹好似只有一种颜色，文本突出显示颜色才有多种

不是的，在段落选项卡里找找看。

weiyingde

谢谢答复，盼能给段代码。

daibao88

Sub 查找并替换指定字符原有的底纹()
    Dim tm As Single, rg As Range
    tm = Timer
    Set rg = ActiveDocument.Content
    Do
        With rg.Find
            .ClearFormatting
            .MatchWildcards = True
            With .Replacement
                .ClearFormatting
                With .Font
                    .Name = ""
                    .ColorIndex = wdBlack
                    '   .Shading.Texture = wdTextureNone
                    '   .Shading.ForegroundPatternColor = wdColorPink
                End With
            End With
            .Execute "[0-9]@ Excelhome_Word"
            If .Found = True Then
                .Parent.Shading.ForegroundPatternColor = wdColorPink
                Set rg = ActiveDocument.Range(.Parent.End, ActiveDocument.Range.End - 1)
            Else
                Exit Do
            End If
        End With
    Loop
    MsgBox "Word共用时" & Timer - tm, vbInformation
End Sub