Как использовать Selection.Find в текстовых полях объекта рисования Word

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.TextFrame.TextRange.

Я «подправил» код, который вы опубликовали для работы вне Word:

• Я полностью определил объекты Word; чтобы использовать код в его нынешнем виде, требуется ссылка на библиотеку объектов Word в проекте VBA.

• Я квалифицировал объект Word ActiveDocument с помощью переменной приложения Word objWord

• Я заменил ваш Range объект (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