Висячие предлоги,как убрать?

[aequit]

почему то виснет напрочь на таблицах и рисунках.
Может можно переписать действие макроса только на выделенный фрагмент текста?

Действительно, в таблицах не работает.
Начальный фрагмент обрабатываемого текста можно указать, поставив курсор на нужное место и удалив строку

Selection.HomeKey Unit:=wdStory

А вот как задать нижний диапазон для обработки или ограничить действие макроса только выделением?

[korney4]

После выполнения макроса Word намертво виснет, в описании проблемы указно следующее:
Описание:
Ошибка привела к остановке взаимодействия программы с Windows.

Сигнатура проблемы:
Имя события проблемы: AppHangB1
Имя приложения: WINWORD.EXE
Версия приложения: 12.0.4518.1014
Отметка времени приложения: 45428028
Сигнатура зависания: 7ca6
Тип зависания: 0
Версия ОС: 6.1.7601.2.1.0.256.48
Код языка: 1049
Доп. сигнатура зависания 1: 7ca6c2cbbb26cd446e9abe00a49dc2c4
Доп. сигнатура зависания 2: 11dd
Доп. сигнатура зависания 3: 11ddfad8eab95052edc522bd377231cd
Доп. сигнатура зависания 4: 7ca6
Доп. сигнатура зависания 5: 7ca6c2cbbb26cd446e9abe00a49dc2c4
Доп. сигнатура зависания 6: 11dd
Доп. сигнатура зависания 7: 11ddfad8eab95052edc522bd377231cd

[Ципихович Эндрю]

так код макроса тоже выложите

[korney4]

вот этот макрос, предложенный Казанским:

Сообщение от Казанский

Изменил условие: перед заменяемым пробелом должна быть буква

Sub ВисячиеПредлоги1()
Dim s$, n&
  Selection.HomeKey Unit:=wdStory
  Do
    Selection.EndKey Unit:=wdLine
    If Selection.End + 1 >= ActiveDocument.Range.End Then Exit Do
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    s = Selection.Text
    If s = vbCr Then  'пустой абзац, выделение сместилось на строку вверх!
      Selection.MoveDown Unit:=wdLine, Count:=1
    ElseIf LCase$(Right$(s, 2)) Like "[a-zа-яё] " And (Len(s) = 2 Or Len(s) = 3) Then
      Selection.EndKey Unit:=wdLine
      Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
      Selection.TypeText Text:=Chr(160) 'неразрывный пробел; происходит переход на сл. строку
      n = n + 1
      Selection.MoveUp Unit:=wdLine, Count:=1
    End If
    Selection.MoveDown Unit:=wdLine, Count:=1
  Loop
MsgBox "Выполнено замен: " & n, vbInformation
End Sub

[shanemac51]

запустила макрос несколько раз и получила некорректные переносы(разорвало на части Петра I и слило несколько коротких слов)

Вопрос 6: Один из ИКСОВ ценят за ярко-голубое донышко бокала. Еще один ИКС — "Царь Петр". Назовите ИКС двумя словами.
...
Ответ: Сорт тюльпана., Вид тюльпана, разновидность тюльпана
_но_он_не_был найден
Комментарий: "Тюльпаном" называется одна из разновидностей бокалов, а цветоводы называют "бокалом" бутон тюльпана. Необычность голубого цвета для тюльпанов заключается в том, что у них нет голубого или синего гена — так же, как, например, и у роз. Жизнь и деятельность Петра
I были тесно связаны с Голландией, и неудивительно, что в честь него назван один из сортов тюльпанов.