Word Макрос: Запретить перенос заданного количества букв

[Администратор]

А в чём выражается "не срабатывает"?

[Anton]

Слово "сути" из 2 слогов, должен сработать запрет на переносы в абзаце. А этот запрет возникает, если я пошагово (через F8 ) прогоняю макрос. А если не пошагово - то не срабатывает и в абзаце переносы не запрещаются.

[Администратор]

Какая версия ворда у вас?

[Anton]

Microsoft Office 2010 v.14.0.7166.5000 x32

[Администратор]

Да, у меня так же. Подумаю, что можно сделать.

[Anton]

Если поможет, то в этой строчке то выполняется условие у меня, то нет. Возможно, я ошибаюсь, но наблюдения показывают пока на нее.

If Right(text, 1) Like "[а-яё]" Then

[Администратор]

Заменил на это:
If Right(text, 1) = "у" Then
всё равно не работает.

[Администратор]

У меня это в коде встречается в двух местах:
If Right(text, 1) Like "[а-яё]" Then

Во втором месте не срабатывает. Я ставлю после этого места Stop и макрос не доходит. А в режиме F8 доходит.

[Администратор]

Проблема была из-за вставки слова. После вставки слова расположение слов было в неправильном положении.
Я добавил команду: Application.ScreenRefresh, чтобы слова встали на свои места.

Макрос

Sub Макрос()
   
    Dim var
   
   
    '1. Поиск в основном тексте.
    Call FindTransports
   
    '2. Поиск в страничных сносках.
    If ActiveDocument.Footnotes.Count > 0 Then
        '1) Отображение снизу области со всеми страничными сносками.
            ' При этом курсор переходит в эту область.
        ' Запоминаем, сколько отображается областей, чтобы понять, открылась область со сносками
            ' или закрылась, т.к. команда ниже делает и то и другое в зависимости от ситуации.
        var = ActiveWindow.Panes.Count
        ' Отображение области со сносками.
        ActiveWindow.View.SplitSpecial = wdPaneFootnotes
        ' Проверяем, закрылась область или открылась. Если закрылась, то ещё раз открываем.
        If ActiveWindow.Panes.Count < var Then
            ' Отображение области со сносками.
            ActiveWindow.View.SplitSpecial = wdPaneFootnotes
        End If
        '2) Поиск.
        Call FindTransports
        '3) Закрытие области со сносками.
        ActiveWindow.ActivePane.Close
    End If
   
    '3. Поиск в концевых сносках.
    If ActiveDocument.Endnotes.Count > 0 Then
        '1) Отображение снизу области со всеми концевыми сносками.
        var = ActiveWindow.Panes.Count
        ActiveWindow.View.SplitSpecial = wdPaneEndnotes
        If ActiveWindow.Panes.Count < var Then
            ActiveWindow.View.SplitSpecial = wdPaneEndnotes
        End If
        '2) Поиск.
        Call FindTransports
        '3) Закрытие области со сносками.
        ActiveWindow.ActivePane.Close
    End If

    '4. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

Sub FindTransports()
   
    ' Selection.MoveDown не используется, т.к. происходил перескок через строку.
        ' Это даже было в самом ворде.
    ' Selection.GoTo не используется, т.к. курсор выходит из области сносок.
   
    Dim text As String, lngEnd As Long
    Dim word As Range, trans As String
   
   
    '1. Установка текстового курсора в начало области (RangeStory).
    Selection.HomeKey Unit:=wdStory
   
    '2. Запись конца области в переменную.
    lngEnd = ActiveDocument.StoryRanges(Selection.StoryType).End - 1
   
    '3. Цикл по строкам.
    Do
   
        ' Если курсор в таблице, то выход из таблицы.
        If Selection.Information(wdWithInTable) = True Then
            Selection.Tables(1).Range.Characters.Last.Next.Select
        End If
       
        ' Выделение строки и копирование её текста в переменную.
        Selection.Expand Unit:=wdLine
        text = LCase(Selection.text)
       
        ' Если справа буква, значит есть автоперенос текста.
        If Right(text, 1) Like "[а-яё]" Then
            ' Переход в нижнюю строку и копирование её текста в переменную.
            Selection.Move Unit:=wdLine, Count:=1
            Selection.Expand Unit:=wdLine
            text = LCase(Selection.text)
            ' Если в начале есть две или три русские буквы, а затем не русская буква.
            If (text Like "[а-яё][а-яё][!а-яё]*") Or (text Like "[а-яё][а-яё][а-яё][!а-яё]*") Then
           
                ' Вставка ручных переносов и удаление последнего переноса.
                '1) Присваивание имени "word" перенесённому слову.
                Set word = Selection.Words(1)
                '2) Копирование слова в переменную.
                trans = word.text
                '3) Установка переносов в переменной "trans".
                trans = HyphenateWord$(trans, Chr(31))
                '4) Удаление последнего переноса.
                trans = StrReverse(Replace(StrReverse(trans), Chr(31), "", , 1))
                '5) Вставка слова в файл.
                word.text = trans
                '6) Обновление экрана, иначе в "Word 2010" неправильная разметка после вставки слова.
                Application.ScreenRefresh
               
                ' Запись конца области в переменную.
                lngEnd = ActiveDocument.StoryRanges(Selection.StoryType).End - 1
               
                ' Выделение строки и копирование её в переменную "text".
                Selection.Expand Unit:=wdLine
                text = LCase(Selection.text)
               
                ' Если справа буква, значит есть автоперенос текста.
                If Right(text, 1) Like "[а-яё]" Then
               
                    ' Переход в нижнюю строку и копирование её текста в переменную.
                    Selection.Move Unit:=wdLine, Count:=1
                    Selection.Expand Unit:=wdLine
                    text = LCase(Selection.text)
                   
                    ' Если в начале есть две или три русские буквы, а затем не русская буква.
                    If (text Like "[а-яё][а-яё][!а-яё]*") Or (text Like "[а-яё][а-яё][а-яё][!а-яё]*") Then
                        ' Отключение автопереноса в этом абзаце.
                        Selection.ParagraphFormat.Hyphenation = False
                        ' Переход в следующую строку, чтобы снять выделение, иначе будет
                            ' выделено две строки.
                        Selection.Move Unit:=wdLine, Count:=1
                    End If
                End If
            End If
        Else
            ' Переход на следующую строку.
            Selection.Move Unit:=wdLine, Count:=1
            ' Если достигнут конец области.
                ' С помощью самого "Move" не получается узнать, достигнут ли конце области,
                ' т.к. используется выделение строки и ворд всегда считает, что произошёл переход
                ' на следующую строку (брак в ворде).
            If Selection.End = lngEnd Then
                Exit Sub
            End If
        End If
       
    Loop
   
End Sub

[свернуть]

[Anton]

Большое спасибо!

[Anton]

Могу я задать уточняющий вопрос? Пробую немного изучать макросы. Почему логика указанного ниже выражения именно такая?
А если справа будет стоять союз? Тоже ведь буква.

  ' Если справа буква, значит есть автоперенос текста.
        If Right(text, 1) Like "[а-яё]" Then

Догадался сам. Как-то не думал, что строки оканчиваются пробелами.