Question

我正在尝试查找Word文档中某些单词的所有出现并删除它，但是由于我不知道的原因，它不会删除文本框中的单词。

（注意：这些是从Building Block插入的图形对象文本框。）

这是我的代码：

Dim myRange As Range

For i = LBound(arr) To UBound(arr)

    Set myRange = Selection.Range
    myRange.WholeStory
    myRange.Select

    With objWord.Selection.Find
                        .ClearFormatting
                        .Text = arr(i)
                        .Replacement.Text = ""
                        .Forward = True
                        .Wrap = wdFindContinue
                        .MatchCase = False
                        .MatchWholeWord = False
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                        .Execute Replace:=wdReplaceAll
    End With

Next i

我试图添加一些代码来搜索单词文档的形状，因为我在网上看到了它，但是它也不起作用。

它看起来像这样：

Dim myRange As Range
Dim shp As Shape

For i = LBound(arr) To UBound(arr)
    Set myRange = Selection.Range
    myRange.WholeStory
    myRange.Select
    With objWord.Selection.Find
                        .ClearFormatting
                        .Text = arr(i)
                        .Replacement.Text = ""
                        .Forward = True
                        .Wrap = wdFindContinue
                        .MatchCase = False
                        .MatchWholeWord = False
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                        .Execute Replace:=wdReplaceAll
    End With


For Each shp In ActiveDocument.Shapes
    If shp.Type = msoTextBox Then
        shp.Select
        With Selection.Find
                    .ClearFormatting
                    .Text = arr(i)
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    .Execute Replace:=wdReplaceAll
    End With
    End If
Next


Next i

Answer 1

这类文本框是绘图对象，因此您尝试使用Shapes集合是一个好的开始。为了到达Shape（图形对象）内部的文本范围，您需要Shape.TextFrame.TextRange属性。

我已经“调整”了您发布的代码以从Word外部使用：

我完全限定了Word对象；为了按原样使用该代码，需要在VBA项目中引用Word对象库。
我已使用Word应用程序变量ActiveDocument

objWord

我已将Range的{{1}}对象（myRange）替换为Selection.Find，并将其设置为Word文档的整个正文
我将Find.Wrap的设置更改为wdFindStop，因为wdFindContinue在VBA中非常危险（它可能会陷入无限循环）

这应该可以帮助您。

Sub FindInTextBoxes()
    Dim myRange As Word.Range
    Dim shp As Word.Shape
    Dim shpRange As Word.Range
    Dim objWord as Word.Application

    Set objWord = GetObject(, "Word.Application")
    'Assumes the document is already open in Word

    For i = LBound(arr) To UBound(arr)
        Set myRange = objWord.ActiveDocument.Content
        With myRange.Find
                            .ClearFormatting
                            .Text = arr(i)
                            .Replacement.Text = ""
                            .Forward = True
                            .wrap = wdFindStop
                            .MatchCase = False
                            .MatchWholeWord = False
                            .MatchWildcards = False
                            .MatchSoundsLike = False
                            .MatchAllWordForms = False
                            .Execute Replace:=wdReplaceAll
        End With


        For Each shp In obWord.ActiveDocument.Shapes
            If shp.Type = Office.MsoShapeType.msoTextBox Then
                Set shpRange = shp.TextFrame.TextRange
                With shpRange.Find
                    .ClearFormatting
                    .Text = arr(i)
                    .Replacement.Text = ""
                    .Forward = True
                    .wrap = wdFindStop
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    .Execute Replace:=wdReplaceAll
                End With
            End If
        Next
    Next i
End Sub

如何在Word的绘图对象文本框中使用Selection.Find

1 个答案: