yshindin пишет:Fck_This пишет:Какая есть возможность совершить поиск в определённой области документа?
Вы можете выполнять поиск по диапазону с помощью как раз метода Range.Find. В примере привожу поиск по стилю (стартовая программа - SearchByStyleInRange, она в процессе цикла поиска вызывает подпрограмму RangeStartEndOfStyleInRange. Подпрограмма возвращает границы диапазона найденного текста (или -1, если текст не найден). Закладка на найденном тексте создается на случай необходимости чтения или изменения найденного текста - тогда его можно найти по диапазону этой закладки.
Sub SearchByStyleInRange()
Dim sr As range
Dim ok_to_search As Boolean
Dim search_style_name As String
Dim search_style As Style
Dim ss_start As Long
Dim ss_end As Long
Dim text_found As String
Dim search_found_bookmark_name As String
Set sr = ActiveDocument.range
search_style_name = "DFN" 'find text in this style
ok_to_search = True
On Error Resume Next
Set search_style = ActiveDocument.Styles(search_style_name)
On Error GoTo 0
search_found_bookmark_name = "SearchFoundBookmark" 'bookmark for the text found
If Not (search_style Is Nothing) Then
While ok_to_search
'Search by style
RangeStartEndOfStyleInRange sr, search_style, ss_start, ss_end
If ss_start = -1 Then 'text not found = stop the search
ok_to_search = False
Else 'text is found
'set bookmark
If ActiveDocument.Bookmarks.Exists(search_found_bookmark_name) Then
ActiveDocument.Bookmarks(search_found_bookmark_name).Delete
End If
ActiveDocument.Bookmarks.add range:=sr, name:=search_found_bookmark_name
'process the found text
text_found = ActiveDocument.Bookmarks(search_found_bookmark_name).range.Text
' . . . .
End If
Wend
End If
End Sub
Sub RangeStartEndOfStyleInRange(ByRef rgf As range, ByRef st As Style, ByRef fst_start As Long, ByRef fst_end As Long)
'find text with style 'st' in the 'rgf' range.
'the found text boundaries are determined (for not found the -1;-1 values are returned).
fst_start = -1
fst_end = -1
With rgf.Find
.ClearFormatting
.Style = st
.Forward = True
.Format = True
.Text = ""
.Execute
End With
If rgf.Find.found = True Then
fst_start = rgf.Start
fst_end = rgf.End
End If
End Sub
Уважаемы, скажите, а это будет работать, если мне нужно найти все вхождения текста в области? Я делал поиск по области
с маской поиска
OurRange.Find.Text "anytext"
через цикл
Do while OurRange.Find.Execute = True
. И дело в том, что у меня несколько масок поиска, а макрос, когда обрабатывает первое выражение, OurRange делает равным маске поиска и это всё сбивает.
Вот полный кусок кода
Set OurRange = ActiveDocument.Paragraphs(iNumberOne).Range
OurRange.SetRange Start:=OurRange.Start, End:=ActiveDocument.Paragraphs(iNumberTwo).Range.End
'Устанавливаем свою область
For i = 1 To 10
x = 0
With OurRange.Find
.Text = FindArray(i)
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
TextOne = OurRange
TextTwo = Peremennaya
MsgBox TextOne & TextTwo
'ПОиЗА будет выполняться, пока будут попадаться вхождения
Do While Selection.Find.Execute = True
Peremennaya = OurRange.Find.Parent
'Отсейка
'На данном этапе происходит очистка найденной переменной от (по порядку): Замена неразрывного дефиса Chr(30) на обычный Chr(150)
'Выпил точки с запятой "Chr(59)" _ запятой "Chr(44)" _ Открывающей скобки "Chr(40)" _ Знака абзаца "Chr(13)" _
'Неразрывный пробел Chr(160) будет изменён на обычный Chr(32) _ Справа будут удалены пробелы RTrim и точка Chr(46), если есть
If InStr(Peremennaya, Chr(30)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(30), Chr(150))
End If
If InStr(Peremennaya, Chr(59)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(59), ReplaceText)
End If
If InStr(Peremennaya, Chr(44)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(44), ReplaceText)
End If
If InStr(Peremennaya, Chr(40)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(40), ReplaceText)
End If
If InStr(Peremennaya, Chr(13)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(13), ReplaceText)
End If
If InStr(Peremennaya, Chr(160)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(160), Chr(32))
End If
If InStr(Peremennaya, Chr(42)) >= 1 Then
Peremennaya = Replace(Peremennaya, Chr(42), ReplaceText)
End If
Peremennaya = RTrim(Peremennaya)
If Right(Peremennaya, 1) = Chr(46) Then
PeremEdit = Len(Peremennaya) - 1
Peremennaya = Left(Peremennaya, PeremEdit)
End If
If Len(Peremennaya) <= 5 Then
x = x
GoTo Line00
End If
'Условия для сравнения переменной со значениями из массива. Если значения равны - повторяет цикл. Если в значении Переменной
'содержится значение массива - значение массива будет изменено. Если в значении массива содержится значение переменной, то
'цикл повторится. Значение переменной в первом и третьем случае не будет занесено в массив.
'Пометка 1
If Not FirstStorageArray(1) = Empty Then
For FromLowerToUpper = LBound(FirstStorageArray) To UBound(FirstStorageArray)
If Peremennaya Like FirstStorageArray(FromLowerToUpper) Then
GoTo Line00
ElseIf InStr(Peremennaya, FirstStorageArray(FromLowerToUpper)) >= 1 Then
FirstStorageArray(FromLowerToUpper) = Peremennaya
GoTo Line00
ElseIf InStr(FirstStorageArray(FromLowerToUpper), Peremennaya) >= 1 Then
GoTo Line00
End If
Next FromLowerToUpper
End If
x = x + 1
ReDim Preserve FirstStorageArray(x)
FirstStorageArray(x) = Peremennaya
Line00:
Set OurRange = ActiveDocument.Paragraphs(iNumberOne).Range
OurRange.SetRange Start:=OurRange.Start, End:=ActiveDocument.Paragraphs(iNumberTwo).Range.End
Loop
End With
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871
