Как получить коллекцию найденного из myRange.Find.Execute?
Остановился тут:
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:=mText, Forward:=True, MatchWildcards:=True
If myRange.Find.Found = True Then
First = myRange.Text [B]' а тут бы узнать номер страницы, а потом и номера остальных вхождений[/B]
End If
Спасибо за картинку - похоже то, что надо. А подскажите, пжл, где тот самый ответ? Или по какому запросу его найти на форуме?
Заранее спасибо.
Я не чево Вам не посылал на мыло
Вот Вам вариант макроса
Шаг 1) Запуск макроса
frm_Find - имя главной формы макроса
Не модальное окно , что-бы видеть результат
frm_Find.Show vbModeless
End Sub
cbo_ResultFind - ComboBox
txt_Find - TexeBox
fra_ResultFind - Frame
chk_MatchCase - CheckBox
chk_WordSymbol - CheckBox
cmd_Start - CommandButton
cmd_ResetSearchColorSelection - CommandButton
Private Sub cbo_ResultFind_DropButtonClick()
Dim str_Split$()
'получить номер страницы
str_Split = Split(cbo_ResultFind.Value, Space(1))
'переход на другую страницу
Selection.GoTo wdGoToPage, wdGoToAbsolute, Val(str_Split(1))
End Sub
Private Sub chk_MatchCase_Change()
'reset color Black
ResetColorBlack
End Sub
Private Sub chk_WordSymbol_Change()
If chk_WordSymbol.Value Then
chk_WordSymbol.Caption = "Поиск слова"
txt_Find.MaxLength = 25
txt_Find.Text = ""
Else
chk_WordSymbol.Caption = "Поиск символа"
txt_Find.MaxLength = 1
txt_Find.Text = ""
End If
'reset color Black
ResetColorBlack
End Sub
Private Sub cmd_Start_Click()
If txt_Find.TextLength = 0 Then Exit Sub
RemovingItemsComboBox
'отключить экран (во время выполнения макроса)
Application.ScreenUpdating = False
Dim int_SearchResultOnPage%
Dim DocumentPages%()
Dim rng_Range As Range
Dim int_MemPageStart%
int_MemPageStart = 1
Set rng_Range = ActiveDocument.Range
ReDim DocumentPages(rng_Range.Information(wdActiveEndPageNumber), 0)
With rng_Range.Find
.Text = txt_Find.Text 'Что искать
.MatchCase = chk_MatchCase 'Учитывать регистр
.MatchWholeWord = chk_WordSymbol.Value 'Words/Characters
Do While .Execute
DoEvents
If rng_Range.Information(wdActiveEndPageNumber) = int_MemPageStart Then
'подщет совпадений на стронице
int_SearchResultOnPage = int_SearchResultOnPage + 1
Else
'переход на другую страницу
int_MemPageStart = rng_Range.Information(wdActiveEndPageNumber)
int_SearchResultOnPage = 1
End If
'запись в массив совпадений на странице
DocumentPages(rng_Range.Information(wdActiveEndPageNumber), 0) = int_SearchResultOnPage
Loop
End With
'проверка
If int_SearchResultOnPage = 0 Then Exit Sub
fra_ResultFind.Enabled = True
Dim var_SetSearchColorSelect
Set rng_Range = ActiveDocument.Range
'reset color Black
For Each var_SetSearchColorSelect In rng_Range.Characters
If var_SetSearchColorSelect.Font.ColorIndex = wdRed Then
var_SetSearchColorSelect.Font.ColorIndex = wdBlack
End If
Next
'выбор Words/Characters
If chk_WordSymbol.Value Then
'поиск слов
For Each var_SetSearchColorSelect In rng_Range.Words
If RTrim(var_SetSearchColorSelect.Text) = txt_Find.Text Then
var_SetSearchColorSelect.Font.ColorIndex = wdRed
End If
Next
Else
'поиск Characters
For Each var_SetSearchColorSelect In rng_Range.Characters
If var_SetSearchColorSelect.Text = txt_Find.Text Then
var_SetSearchColorSelect.Font.ColorIndex = wdRed
End If
Next
End If
'удалить объест
Set rng_Range = Nothing
'настройка ComboBox
With cbo_ResultFind
.ColumnCount = UBound(DocumentPages)
.ColumnWidths = "45;20;80"
.ColumnHeads = False
.RowSource = ""
End With
Dim int_CountPageFind%
'заполнить ComboBox
For int_SearchResultOnPage = 1 To UBound(DocumentPages)
'не показывать страницы, где нет "Совпадений"
If DocumentPages(int_SearchResultOnPage, 0) <> 0 Then
cbo_ResultFind.AddItem "Страница" & Str(int_SearchResultOnPage)
cbo_ResultFind.List(int_CountPageFind, 1) = Str(int_SearchResultOnPage)
cbo_ResultFind.List(int_CountPageFind, 2) = "Совпадений " & DocumentPages(int_SearchResultOnPage, 0)
int_CountPageFind = int_CountPageFind + 1
End If
Next
cbo_ResultFind.ListIndex = 0
End Sub
Private Sub cmd_ResetSearchColorSelection_Click()
Dim rng_Range As Range
Dim var_ResetSearchColSel
'reset color Black
ResetColorBlack
RemovingItemsComboBox
'удалить объест
Set rng_Range = Nothing
End Sub
Private Sub RemovingItemsComboBox()
'Removing Items ComboBox
Do While cbo_ResultFind.ListCount > 0
cbo_ResultFind.RemoveItem (0)
Loop
cbo_ResultFind.Text = ""
fra_ResultFind.Enabled = False
End Sub
Private Sub ResetColorBlack()
Dim rng_Range As Range
Dim var_SetSearchColorSelect
Set rng_Range = ActiveDocument.Range
'reset color Black
For Each var_SetSearchColorSelect In rng_Range.Characters
If var_SetSearchColorSelect.Font.ColorIndex = wdRed Then
var_SetSearchColorSelect.Font.ColorIndex = wdBlack
End If
Next
'удалить объест
Set rng_Range = Nothing
End Sub
Этот макрос напечатан слету и без теста и имеет ряд проблем с big doc
P/S
Если будет интерес доработаю только нужно время!!!
Просто на почте было оповещение о наличии ответа в теме и показан сам ответ (код макроса). А на странице форума я этого кода не увидел.
Этот макрос напечатан слету и без теста и имеет ряд проблем с big doc
P/S
Если будет интерес доработаю только нужно время!!!
Большое спасибо за работу. Сразу разобраться в логике сложнова-то. + Интерфейс скорее для учебных целей полезен (у меня макросы все молчаливые). И задачка немного видоизменилась (да еще и с учетом непонятного поведения поиска Ворда).
Итак. В тексте есть как бы содержание, - просто перечисление тем, рубрик и название статей. В некоторых абзацах в скобках указаны уровни заголовка - (раздел) (4-5 вхождений) и (рубрика) (штук 10).
Надо найти, указанные в содержании тексты разделов и рубрик и далее (в основном тексте) подставить к ним теги типа Rubrika и Razdel.
Я запускаю поиск по слову "(раздел)" - находится абзац (в содержании). Слово "(раздел)" из этого найденного удаляется, что бы не находиться снова в этом же месте, "запоминается" текст абзаца, который и ищется в документе. В идеале на втором вхождении и надо ставить тег. Так у меня и сделан макрос. Но поиск в ворде происходит не сначала, а с места последнего найденного. Поэтому второе вхождение второго образца текста (рубрика) находится не в осн. тексте, а в содержании, и туда дописывается тег.
То есть задача: найти все вхождения текста рубрики (по логике их должно быть всего два, одно - в содержании) и поставить тег на то вхождение, у которого наибольшой номер страницы. То есть похоже, требуется двумерный массив. В результате окончательно запутался, как это записать.
Что я понял это
Содержание
рубрика1
рубрикаN
название статей1
название статейN
Вот тут бы и далее на палъцах
P/S
Напоминает гиперссылки в документе формата RTF
Структура текста такая:
СОДЕРЖАНИЕ
МНЕНИЕ (раздел)
Иванов Л. А.
Название статьи
ВЕКТОР (раздел)
Петрова О. А.
Название другой статьи
ЦЕЛИ И ЗАДАЧИ (рубрика)
Сидоров С. В.
Название третьей статьи
ПРАКТИКА (рубрика)
Иванов Е. С.
Название четвертой статьи
МНЕНИЕ (раздел)
Название статьи
Текст статьи…
ВЕКТОР (раздел)
Название другой статьи
Текст статьи…
Цели и задачи (рубрика)
Название третьей статьи
Текст статьи…
Практика (рубрика)
Название четвертой статьи
Текст статьи…
-------------
В тексте присутствует 3-5 разделов и 5-10 рубрик. Они не нумерованы, а просто отмечены словом в скобках (раздел,рубрика).
Задача:
1. найти все разделы [вне содержания] и подставить к ним метку Zag1 (инструкция insertBefore)
2. найти все рубрики [вне содержания] и подставить к ним метку Zag2.
Проблема в том, что макрос может считать, что находит "новые" вхождения заданного текста, при этом оставаясь на одном и том же месте. Поэтому мне надо отделять найденное вхождение на той же странице (№1) от случаев на страницах с большим номером. Иначе часть меток приписывается к рубрикам и разделам в самом содержании.