Макрос, находящий предлоги в конце строки

Sub Буксир() ' Буксир Макрос
    Selection.Find.ClearFormatting              ' не учитывать формат искомых слов
    Selection.Find.Replacement.ClearFormatting  ' не применять формат призамене
    
    With Selection.Find                         ' далее работа с окном поиска и замены
    
        .Text = " ([A-zА-я]) {1;}"              ' Пробел(ы) (1 и более) после одинокой буквы
        .Replacement.Text = " \1^s"             'заменим на ту же букву с НЕРАЗРЫВНЫМ пробелом.
        
        .MatchWildcards = True                  ' флажок Подстановочные знаки (по Ctrl-h в документе Word)
        .Execute Replace:=wdReplaceAll          ' соответствует кнопке "Заменить все"
    
        .Text = " вместо "
        .Replacement.Text = "^&^s"
        .MatchWildcards = False                 ' подстановочные знаки здесь и далее не используем
        .Execute Replace:=wdReplaceAll
    
        .Text = " об "
        .Replacement.Text = "^&^s"
        .Execute Replace:=wdReplaceAll
    
        .Text = "перед "
        .Replacement.Text = "^&^s"
        .Execute Replace:=wdReplaceAll
    
        .Text = " про "
        .Replacement.Text = "^&^s"
        .Execute Replace:=wdReplaceAll
    
        .Text = " сверх "
        .Replacement.Text = "^&^s"
        .Execute Replace:=wdReplaceAll
    
        .Text = " через "
        .Replacement.Text = "^&^s"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^0032^0160"            ' текст из пары побелов (простого, код 32, и неразрывного, код 160)
        .Replacement.Text = "^0160"     ' меняем на 1 пробел - неразрывный
        .Execute Replace:=wdReplaceAll
        
    End With
End Sub

.Text=" перед "

Option Explicit
 
Function IsEndOfLine(rng As Range) As Boolean
  Dim lineNum, nextWordLineNum As Long
  Dim retval As Boolean
  Dim nextWord As Range
  Set nextWord = rng.Words.Last.Next(wdWord)
  'Номер строки, на которой находится заданный диапазон
  lineNum = rng.Characters(2).Information(wdFirstCharacterLineNumber)
  'Номер строки, на которой находится следующее слово
  nextWordLineNum = nextWord.Information(wdFirstCharacterLineNumber)
  
  retval = lineNum <> nextWordLineNum
  If retval Then
    Debug.Print "Line number: " & lineNum
    Debug.Print "Next word line number: " & nextWordLineNum
  End If
  IsEndOfLine = retval
End Function
 
 
Sub FixOrphanePrep()
  Selection.HomeKey wdStory
  'Ищем предлоги — от одной до трёх букв, отделённых пробелами от остальных слов
  With Selection.Find
    .Text = "( [А-Яа-я]{1;3}) "
    .MatchWildcards = True
    While .Execute
      'Если найденное слово находится в конце строки
      If IsEndOfLine(.Parent.Range) Then
        'Последний символ (пробел) меняем на неразрывный пробел
        .Parent.Characters.Last.Text = ChrW(160)
        'Сворачиваем выделение, чтобы продолжить поиск
        Selection.Collapse wdCollapseEnd
      End If
    Wend
  End With
End Sub