Vba 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

I am not proud of this solution ….

I look for a string in a word document and publish the result in a table of another word document …
The table is divided into 3 parts: in the center the string I searched for, in the first column «x number of words» to the left of the string and in the third column «y number of words» to the right of the searched string.
But it’s very slow … better solutions?
Thank you

Sub Cerca(Parola, Destinazione)

Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim Prima As Long
Dim Dopo As Long
Dim PosizioneAttuale As Long
Dim strSinistra As String
Dim strCentro As String
Dim strDestra As String
Dim UltimaRiga As Long
Dim Ciclo As Long
Dim Sicurezza As Long

Selection.HomeKey Unit:=wdStory
'Selection.Find.ClearFormatting

 With Selection.Find
     .Text = Parola
    ' .Replacement.Text = "Provo"
     .Forward = True
     .Wrap = wdFindStop
     .IgnorePunct = True
     .MatchWholeWord = ParoleIntere
     .ClearFormatting
     .Format = False
     Do While .Execute() = True

         DoEvents

         PosizioneAttuale = Selection.Start


         'SI CONTROLLA A DESTRA
         Ciclo = 0
         Sicurezza = 0
         Do
            'DoEvents
            Sicurezza = Sicurezza + 1
            Selection.MoveRight Unit:=wdWord, Count:=1
            If InStr(1, ".,;:-_/!'()" & Chr(34) & vbCrLf, Trim(Selection.Range.Words.Item(1)), vbTextCompare) = 0 Then
                Ciclo = Ciclo + 1
            End If
            If Sicurezza > 100 Then
                'Debug.Print "esco con exit do"
                'Selection.MoveLeft Unit:=wdWord, Count:=501
                Exit Do 'nel caso entri in loop per qualche motivo
            End If
         Loop Until Ciclo = ParoleDopo Or Selection.Range.Start = ActiveDocument.Range.End

         Selection.MoveRight Unit:=wdWord, Count:=1
         Set rng2 = Selection.Range

         Selection.Start = PosizioneAttuale


         'SI CONTROLLA A SINISTRA

         Ciclo = 0
         Sicurezza = 0
         Selection.MoveLeft Unit:=wdWord, Count:=1
         Do
            'DoEvents
            Sicurezza = Sicurezza + 1
            Selection.MoveLeft Unit:=wdWord, Count:=1
            If InStr(1, ".,;:-_/!'()", Trim(Selection.Range.Words.Item(1)), vbTextCompare) = 0 Then
                Ciclo = Ciclo + 1
            End If
            If Sicurezza > 100 Then
                Debug.Print "esco con exit do"
                'Selection.MoveRight Unit:=wdWord, Count:=501
                Exit Do 'nel caso entri in loop per qualche motivo
            End If
         Loop Until Ciclo = ParolePrima Or Selection.Range.Start = ActiveDocument.Range.End



         'Selection.MoveLeft Unit:=wdWord, Count:=ParolePrima + 1
         Set rng1 = Selection.Range

         Prima = rng1.Start
         Dopo = rng2.Start

         If Dopo > Prima Then
                 Set rngFound = ActiveDocument.Range(Prima, Dopo)

                 strTheText = rngFound.Text



                 'ScriviFile Left(strTheText, Prima) & Chr(9) & Parola & Chr(9) & Mid(strTheText, Dopo)
                 strSinistra = Left(strTheText, PosizioneAttuale - Prima)
                 strCentro = Parola
                 Prima = PosizioneAttuale + Len(Parola)
                 If Prima = -1 Then Prima = 0
                 strDestra = Right(strTheText, Dopo - Prima)


                 Selection.Start = PosizioneAttuale
                 Selection.MoveRight Unit:=wdWord, Count:=1

                 'scrivo nella tabella del foglio destinazione
                  Documents(Destinazione).Tables(1).Rows.Add
                  UltimaRiga = Documents(Destinazione).Tables(1).Rows.Count
                      Documents(Destinazione).Tables(1).Cell(UltimaRiga, 1).Range.InsertAfter strSinistra
                      Documents(Destinazione).Tables(1).Cell(UltimaRiga, 2).Range.InsertAfter strCentro
                      Documents(Destinazione).Tables(1).Cell(UltimaRiga, 3).Range.InsertAfter strDestra



         End If

     Loop
 End With
End Sub