Vba 如何用相同长度的空格替换选定范围内的文本？

下面的代码最终删除了文本-我想保留找到的内容的长度，并用空格或一些随机字符*替换实际的着色区域，保留着色

尝试使用字符计数和字符串（charcount，“”）进行操作 无济于事

   Sub changecolor()
   Dim rg As Range
   Set rg = ActiveDocument.Range
   With rg.Find
   .Format = True
   .Text = ""
   .Font.Shading.BackgroundPatternColor = RGB(255, 192, 0)
   .Replacement.Text = ""
   While .Execute
   rg.Font.Shading.BackgroundPatternColor = RGB(0, 0, 0)
   rg.Font.Color = wdColorBlack
   rg.Collapse wdCollapseEnd
   Wend
   End With
   Call ReplaceBlack
   End Sub


  Sub ReplaceBlack()
'
    With Selection.Find
     charc = Len(Selection)
    .Format = True
    .Text = ""
    .Font.Shading.BackgroundPatternColor = RGB(0, 0, 0)
    .Replacement.Text = String(charc, "")

    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting

   End Sub

---

问题中代码的问题在于，它在执行

Find

之前测量

选择的长度。因此，字符数将始终是在该点选择的任何字符数

必须首先执行查找，并且对于着色的每个实例，因为着色内容的长度可能不同。由于需要对每个实例执行此操作，因此可以将其合并到原始循环中，而不是在第二个循环中执行

下面的代码使用目标
范围
对象
rg
，将整个颜色更改、字体更改和文本替换移动到
ReplaceBlack
，该对象作为参数传递给
ReplaceBlack

Sub changecolor()
   Dim rg As Range
   Set rg = ActiveDocument.Range
   With rg.Find
    .Format = True
    .Text = ""
    .Font.Shading.BackgroundPatternColor = RGB(255, 192, 0)
    .Replacement.Text = ""
    While .Execute
        ReplaceBlack rg
    Wend
   End With

End Sub

Sub ReplaceBlack(rg As Range)
      rg.Font.Shading.BackgroundPatternColor = RGB(0, 0, 0)
      rg.Font.color = wdColorBlack
      charc = Len(rg)
      rg.Text = String(charc, "*")
      rg.Collapse wdCollapseEnd
 End Sub

问题中代码的问题在于，它在执行
Find
之前测量
选择的长度。因此，字符数将始终是在该点选择的任何字符数

必须首先执行查找，并且对于着色的每个实例，因为着色内容的长度可能不同。由于需要对每个实例执行此操作，因此可以将其合并到原始循环中，而不是在第二个循环中执行

下面的代码使用目标
范围
对象
rg
，将整个颜色更改、字体更改和文本替换移动到
ReplaceBlack
，该对象作为参数传递给
ReplaceBlack

Sub changecolor()
   Dim rg As Range
   Set rg = ActiveDocument.Range
   With rg.Find
    .Format = True
    .Text = ""
    .Font.Shading.BackgroundPatternColor = RGB(255, 192, 0)
    .Replacement.Text = ""
    While .Execute
        ReplaceBlack rg
    Wend
   End With

End Sub

Sub ReplaceBlack(rg As Range)
      rg.Font.Shading.BackgroundPatternColor = RGB(0, 0, 0)
      rg.Font.color = wdColorBlack
      charc = Len(rg)
      rg.Text = String(charc, "*")
      rg.Collapse wdCollapseEnd
 End Sub

下面的答案解决问题了吗？下面的答案解决问题了吗？