MS Word VBA Найти текст вокруг слова

Question

Я бы хотел найти текст в Microsoft Word и получить соседние слова.

Я хотел бы начать со слова и найти все слова до и после него.

Функция должна быть рекурсивной.

Например:

abc def ghi jkl mno def pqr stu wxy def

если я ищу строку «def», функция должна вернуть меня:

abc def ghi mno def pqr wxy def

это возможно?

спасибо!

Sub Cerca(Parola)

Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim Prima As Integer
Dim Dopo As Integer

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

 With Selection.Find
     .Text = Parola
    ' .Replacement.Text = "Provo"
     .Forward = True
     .Wrap = wdFindStop
     Do While .Execute() = True

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

         Selection.MoveLeft Unit:=wdWord, Count:=9
         Set rng1 = Selection.Range

         Prima = rng1.Start
         Dopo = rng2.Start


         Set rngFound = ActiveDocument.Range(Prima, Dopo)
         strTheText = rngFound.Text
         ScriviFile Parola & Chr(9) & strTheText
         'Selection.Find.Replacement.Font.Italic = True
         'Selection.Font.Bold = True
         'Selection.MoveRight Unit:=wdCharacter, Count:=Dopo
        ' Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.MoveRight Unit:=wdWord, Count:=9

     Loop
 End With
End Sub

Процедура, которую я опубликовал, не работает должным образом, потому что она также считает пунктуацию словами.

Я пытаюсь объяснить себя лучше ... Мне нужна функция, которая ищет в документе Microsoft Word строку и получает номер «x» слов перед и после строки, которую я передал. Например ....

function myGetMyListOfSearch(SearchString as string, PreviusWord as integer, NextWord as integer)

Эта функция возвращает мне список «строк» ​​с моим «SearchString», окруженным терминами слева и справа от него ...

это возможно?

Answer 1

Я не горжусь этим решением ....

Я ищу строку в документе word и публикую результат в таблице документа word ... Таблица разбита на 3 части: в центре искомая строка, в первом столбце «x количество слов» слева от строки и в третьем столбце «y количество слов» справа от искомой строки.Но это очень медленно ... лучшие решения?Спасибо

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

Answer 2

A подстановочный знак Найти с помощью:

Find = <[! ] @> [,. ^ Т ^ л ^ 13] @Parola [,. ^ Т ^ л ^ 13] @ <[! ] @>

должно быть достаточно, даже если предыдущее / следующее слово находится в другом абзаце.