Макросы поиск текста word

Вообще документ состоит из нескольких частей (я все не могу вспомнить):

1. колонтитулы,
2. сноски,
3. надписи,
4. собственно документ.

Content — это и есть собственно документ.

Что касается Range, то надо различать:

1. свойство Range;
2. метод Range.

Метод Range есть только у объекта Document (Activedocument) и Shapes (про Shapes не знаю, ни разу не использовал). С помощью метода можно задавать определённый диапазон, например:

1

Activedocument.Range(Start:=0, End:=10)

что означает диапазон документа от начала и до десятого знака включительно. Если ничего не указано:

1

Activedocument.Range

то означает — весь документ. Т.е. в данном случае Range, то же самое, что Content (хотя может разница и есть в чём-то).

В остальных случаях (когда Range не относится к Documents (Activedocument), Range является свойством и с помощью него узнают

порядковый номер символа

(но там путаница большая, если используются в документе кроме символов другие объекты (например, рисунки)) и

содержимое объекта

(например, абзаца):

1
2
3
4

Sub P3()
'Определение номера символа, когда начинается абзац.
MsgBox ActiveDocument.Paragraphs(1).Range.Start
End Sub

1
2
3
4

Sub P4()
'Получаем содержимое абзаца.
MsgBox ActiveDocument.Paragraphs(1).Range
End Sub

ВикиЧтение

VBA для чайников
Каммингс Стив

Sub Выделить_между()
    Dim MyRange As Range, rStart&, rEnd&
    Set MyRange = ActiveDocument.Content
    With MyRange
        With .Find
            .ClearFormatting
            .Text = "Структура активов"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute
            If .Found Then rStart = MyRange.End: rEnd = rStart
        End With
    End With
    Set MyRange = ActiveDocument.Content
    With MyRange
        With .Find
            .Text = "Внеоборотные активы"
            .Execute
            If .Found Then rEnd = MyRange.Start
        End With
    End With
    If rEnd > rStart Then
        ActiveDocument.Range(rStart, rEnd).Select
        Selection.Copy
    End If
End Sub
 
Sub Выделить_между2()
Dim r
Set r = ActiveDocument.Range
With r.Find
    .ClearFormatting
    .Text = "Структура активов*Внеоборотные активы"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
        ActiveDocument.Range(r.Start + 4, r.End - 4).Select
        Selection.Copy
    Else
        MsgBox "Текст не найден!", vbExclamation
    End If
End With
End Sub
Sub Макрос1()
'
' Макрос1 Макрос
 
For Each dd In ActiveDocument.Tables
    asq = asq + 1
    dd.Name
Next
 
End Sub

Валерий спрашивает:

Как из текста в Word 2007 выбрать все слова на определенную букву, расположить их в алфавитном порядке и сохранить их в отдельном файле?

Валерий, вот пример макроса для ваших целей, подсказанный Александром Витером.

Sub startWordsChar2()
'Поиск слов, начинающихся с определенной буквы и перенос их в
'отсортированный по алфавиту список в новый документ
Dim bukva As String
Dim newDoc As Document
Dim actDoc As Document
Dim oPar As Paragraph
Dim rng As Range
Set actDoc = ActiveDocument
Set rng = actDoc.Range
Do
  bukva = InputBox("Введите начальную букву слова в поле:", "Поиск слов")
  If StrPtr(bukva) = 0 Then
     Exit Sub
  ElseIf Len(bukva) = 0 Then
     MsgBox "Введите пожалуйста начальную букву " & vbCr & "или нажмите кнопку 'Cancel"
  End If
Loop Until Len(bukva) <> 0
Application.ScreenUpdating = False
Set newDoc = Documents.Add
'Ищем слово, начинающееся с указанной буквы в любом регистре
With actDoc.Range.Find
  .Text = "<[" & StrConv(bukva & bukva, vbProperCase) & "][А-Яа-яЁё]@>"
  .MatchWildcards = True
  While .Execute
    Application.StatusBar = "Добавляем " & bukva
    newDoc.Range.InsertAfter Trim(.Parent.Text)
    newDoc.Range.InsertParagraphAfter
  Wend
End With
'Сортируем содержимое нового документа
newDoc.Range.Sort , "Paragraphs", wdSortFieldAlphanumeric, wdSortOrderAscending
'Удаляем первый пустой абзац
newDoc.Paragraphs(1).Range.Delete
'Поскольку в каждом абзаце находится по одному слову, то нужно только перебирать абзацы и удалять _
все слова, которые содержатся в текущем
For Each oPar In newDoc.Paragraphs
  If oPar.Range.End <> newDoc.Range.End Then
    With newDoc.Range(oPar.Range.End, newDoc.Range.End).Find
      .Text = oPar.Range.Text
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub

Если вы не знаете, как подключить к документу и применить эти макросы, изучите следующие заметки с сайта:

Создание макроса из готового кода

Автоматическая запись макроса

Dim d As Long, ePos&
    d = 0
    ePos = Selection.End
    'поиск в содержимом выделенного текста
    With Selection.Range.Duplicate.Find
        .Text = "${*}"
        'эта опция отвечает за поиск с использованием подстановочных знаков
        'не работает когда установлено в положение False, или её нет вообще
        'если установлена в положение True, тогда работает
        .MatchWildcards = True
        Do While .Execute
            If .Parent.End > ePos Then Exit Do
            'wdBrightGreen - ярко-зеленый = 4
            'wdwdYellow - желтый = 7
            .Parent.HighlightColorIndex = 7
            d = d + 1
        Loop
    End With