Здравствуйте всем, подскажите, пожалуйста, как из excel в документе word найти определённый текст, выделить его до конца документа и уже выделенный фрагмент заменить данными из ячейки. Сам макрос уже почти готов, но я не знаю как выделить найденный текст и растянуть это выделение до конца документа. Сейчас макрос находит определённый текст и делает замену данных, но как добиться замены не только конкретного текста, а конкретного текста + всё что находится ниже него.
У Вас искомый текст находится в ячейке таблицы с объединенными ячейками, как в примере? Если да, то миссия практически невыполнима. Надо искать ячейку с этим текстом,искать ее RowIndex. Потом перебирать все ячейки таблицы с большим индексом и что то с ними делать
Sub открыть()
Dim objWrdApp As Object
Dim objWrdDoc As Object
On Error Resume Next
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
Set objWrdApp = CreateObject("Word.Application")
Set objWrdDoc = objWrdApp.Documents.Open("C:\word.rtf")
objWrdApp.Visible = True
End If
Set objWrdDoc = objWrdApp.Documents.Open("C:\word.rtf")
ReplacementText = Лист1.[H3]
With objWrdApp.Selection
.HomeKey Unit:=6
.Find.ClearFormatting
With .Find
.Text = "Вот этот текст нужно удалить "
.Forward = True
.Wrap = 0
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
With objWrdApp.Selection
If Not .Find.Execute Then Exit Sub
objWrdApp.Selection.SelectCell
objWrdApp.Selection.Text = Left(objWrdApp.Selection, InStr(objWrdApp.Selection, "Вот этот текст нужно удалить ") - 1) & "Вот этот текст нужно удалить "
objWrdApp.Selection.Next(Unit:=10).Select
objWrdApp.Selection.EndKey Unit:=6, Extend:=1
objWrdApp.Selection.Delete
End With
With objWrdDoc.Content.Find
.Text = "Вот этот текст нужно удалить "
.Replacement.Text = ReplacementText
.Forward = True
.Wrap = 0
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2, Forward:=True, Wrap:=1
End With
End With
End Sub