1

Тема: Определение конца строки

Благодарю за грамотный, познавательный, интереснейший сайт. Наткнулся на него пару недель назад, с жадностью впитываю новую для себя информацию...
Дабы не обременять однотипными вопросами админов пытался найти ответ на интересующую меня тему, но не найдя, решил-таки обратиться с вопросом...
Увлёкся форматированием текста (использую замену, в т. ч. в необходимых случаях с использованием подстановочных знаков). Коснулся вопросов расстановки пробелов. Повсеместная расстановка неразрывных пробелов после предлогов, союзов и частиц (далее -- ПСЧ) визуально портит текст ввиду особенности этого неразрывного пробела -- он нерастягиваемый. Поэтому решил, что было бы неплохо расставлять их только в конце строки.
Вопрос:
Как определить конец строки, которую завершает ПСЧ, и проставить в этом случае неразрывный пробел перед этими ПСЧ? Если не трудно, приведите, пожалуйста, пример такового кода макроса.

2

Re: Определение конца строки

Поможет функция:

Selection.IPAtEndOfLine

Она возвращает True в месте, где текст переходит на следующую строку. Не путать с концом строки! Например, если вставлен символ разрыва строки, то Selection.IPAtEndOfLine=False.
Для перемещения в конец строки к подойдет функция:

Selection.EndOf Unit:=Word.wdLine, Extend:=Word.wdMove

Как перейти на следующую строку думаю догадаетесь…

P.S. Я писал похожий макрос, но до концов строк не додумался. Зато реализовал прикрепление: номеров (Глава 1, 2 место и т.п.), союзов и частиц, крайних слов (в конце предложения, перед/после скобки, кавычки и т.п.)

Макросы под заказ и готовый пакет - mtdmacro.ru

3

Re: Определение конца строки

К сожалению, мои познания в VBA пока ещё недостаточны для того, чтобы сделать это самому. Вынужден снова обращаться к Вам за помощью. Имеется вот такой нижеприведённый код. За основу взят код неизвестного мне разработчика.

Sub SimpleReplace(what, forwhat, checkCase)
    exitPoint = False
    With Selection
        With .Find
            .ClearFormatting
            .Text = what
            .Replacement.ClearFormatting
            .Replacement.Text = forwhat
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = checkCase
            .MatchWildcards = False 'NEW
            .Execute Replace:=wdReplaceAll
            If Not .Found Then
                exitPoint = True
            End If
        End With
    End With
End Sub

...

If MsgBox("Проставить неразрывный пробел после предлогов?", 308, "Шаг 5 из 6") = vbYes Then
    SimpleReplace " в ", " в^s", True
    SimpleReplace " о ", " о^s", True
    SimpleReplace " к ", " к^s", True
    SimpleReplace " от ", " от^s", True
    SimpleReplace " с ", " с^s", True
'   и так далее нужное мне количество вариантов букв
...
End If

Как я понял, в начале макроса определяется некая процедура SimpleReplace, которая в дальнейшем с успехом применяется в нужном количестве раз.
Ума не приложу, честно говоря, куда "всунуть" эту самую Selection.IAPtEndOfLine.
Можно ли её в саму процедуру SimpleReplace включить?
Задача состоит в том, чтобы после этих букв проставлять "неразрывный пробел" ТОЛЬКО, если они находятся в конце строки и после них стоит "пробел".
Буду благодарен, если подскажете, где могу подробнее про это почитать?

Отредактировано Penniwise (09.02.2010 16:22:48)

4

Re: Определение конца строки

Вот замена функции SimpleReplace, делающая замены только в конце строк:

Sub SimpleReplaceAtEndOfLine(what, forwhat, checkCase)
    exitPoint = False
    With Selection
        With .Find
            .ClearFormatting
            .Text = what
            .Replacement.ClearFormatting
            .Replacement.Text = forwhat
            .Forward = True
            .Wrap = wdFindStop
            .MatchCase = checkCase
            .MatchWildcards = False
            Do While .Execute(Replace:=wdReplaceNone)
                exitPoint = True
Dim L&, N&
                L = Selection.Characters.Count
                N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
                If (N = 1) And Selection.IPAtEndOfLine Then
                    Selection.MoveEnd Unit:=Word.wdCharacter, Count:=1 - L - N
                    .Execute Replace:=wdReplaceOne
                Else
                    Selection.MoveEnd Unit:=Word.wdCharacter, Count:=2 - L - N
                End If
            Loop
        End With
    End With
End Sub

Непонятно для чего у вас переменная exitPoint. Я ее воткнул приблизительно. В следующий раз выкладывайте весь код  или компилируемый фрагмент.

Почитать могу посоветовать только Help по VBA встроенный в Word.

Макросы под заказ и готовый пакет - mtdmacro.ru

5

Re: Определение конца строки

Не получилось.
Выкладываю весь макрос.
Изначальный код не мой, я просто разместил объяву, поэтому возможны переменные, смысл которых я пока не знаю. Главное, что я знаю, что они мне пока не мешают, а код я доработал и он функционирует, в принципе, как мне нужно. Исключение составляет лишь этот противный конец строки.
Искомая задача ставится в шаге 5, 6.

Post's attachments

Tipografic.bas 20 Кб, 9 скачиваний с 2010-02-09 

You don't have the permssions to download the attachments of this post.

6

Re: Определение конца строки

Penniwise пишет:

Не получилось...

Да, работать не будет.
Подправьте начало моей процедуры:

Sub SimpleReplaceAtEndOfLine(what, forwhat, checkCase)
    With Selection
        .SetRange 0, 0
        With .Find
...
Макросы под заказ и готовый пакет - mtdmacro.ru

7

Re: Определение конца строки

Работает!!! (смайлик с выпученными глазами)
Огромное спасибо!!!

8

Re: Определение конца строки

С момента внедрения данной функции в макрос работать стало приятнее.
Однако, выявлен баг -- макрос, выполняя свои итерации, вешает процесс winword.exe, вынуждая жёстко его завершать. Происходит это в случае, когда в документе присутствуют перекрёстные ссылки, оглавление. Курсор "добегает" до какой-нибудь перекрестной ссылки (как правило текстовой и, предположительно, содержащей в себе буквосочетание, которое ищет макрос) и останавливается, продолжая очень часто моргать.
С чем это может быть связано? Как это ликвидировать?

Отредактировано Penniwise (05.03.2010 11:48:38)

9

Re: Определение конца строки

Penniwise пишет:

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

Модификация под ссылки и т.п.:

Sub SimpleReplaceAtEndOfLine(what, forwhat , checkCase)
    With Selection
        .SetRange 0, 0
        With .Find
            .ClearFormatting
            .Text = what
            .Replacement.ClearFormatting
            .Replacement.Text = forwhat
            .Forward = True
            .Wrap = wdFindStop
            .MatchCase = checkCase False
            .MatchWildcards = False
            Do While .Execute(Replace:=wdReplaceNone)
Dim R As Word.Range
Dim EOL As Boolean
Dim N&
                Set R = Selection.Range
                N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
                EOL = Selection.IPAtEndOfLine
                R.Select
                If (N = 1) And EOL Then
                    Selection.Collapse Direction:=Word.wdCollapseStart
                    .Execute Replace:=wdReplaceOne
                Else
                    Selection.Collapse Direction:=Word.wdCollapseEnd
                End If
            Loop
        End With
    End With
End Sub

Отредактировано Вождь (05.03.2010 14:37:38)

Макросы под заказ и готовый пакет - mtdmacro.ru

10

Re: Определение конца строки

Благодарю. Теперь работает.
Теперь буду сам пытаться разобраться, как сделать, чтобы после отработки макросом этой его части, курсор и экран возвращался бы в то место, с которого он начал выполнение.

11

Re: Определение конца строки

может подойдет такое решение для возврата:

1. Добавление закладки
    With CurrentDoc.Bookmarks
        .Add Range:=Selection.Range, Name:="Имя_закладки" 'Добавление закладки
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With

2. Переход к нужной закладке
   Selection.GoTo What:=wdGoToBookmark, Name:="Имя_закладки"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Forward = True
        .Wrap = wdFindContinue
    End With

3. Удаление закладки
CurrentDoc.Bookmarks("Имя_закладки").Delete ' Удаление закладки

12

Re: Определение конца строки

Поясню пример andrkar. Т.е. перед выполнением действий с документом, нужно поставить закладку в то место, где находится курсор, а затем, когда всё сделаем, перейти к этой закладке и удалить её.
Эта часть кода для перехода к закладке не нужна:

    With Selection.Find
        .Forward = True
        .Wrap = wdFindContinue
    End With
Лучше день потерять — потом за пять минут долететь!

13

Re: Определение конца строки

Вождь

.MatchCase = checkCase False

у меня vb на данную строку ругается...

14

Re: Определение конца строки

False удали

Лучше день потерять — потом за пять минут долететь!

15

Re: Определение конца строки

На сообщение от 15.03.2010 20:34:18:
По поводу CurrentDoc.Bookmarks у меня говорит, что Variable not defined.
А как что её определить я не знаю.

16

Re: Определение конца строки

Ну конечно будет выдавать.. Нужно еще вот что сделать:

Dim CurrentDoc As Document
Set CurrentDoc = ActiveDocument

17

Re: Определение конца строки

Вождь пишет:

Модификация под ссылки и т.п.:

.MatchWildcards = False

Столкнулся с необходимостью поиска и замены в конце строки с использованием Wildcards. Если изменяю код из 9 сообщения на

.MatchWildcards = True

то макрос выполняется только до первого совпадения и потом завершается. Как заставить его продолжать работу?
И ещё, можно ли ограничить диапазон поиска и замены только выделением, так как

.SetRange 0, 0

сразу переносит курсор в начало документа и начинается обработка всего текста документа sad

18

Re: Определение конца строки

aequit пишет:

...Если изменяю код из 9 сообщения...то макрос выполняется только до...Как заставить его продолжать работу?...

Откуда ж я знаю, не видя ВАШЕГО кода smile
Хотя бы ВАШИ значения what и forwhat сообщите.

Макросы под заказ и готовый пакет - mtdmacro.ru

19

Re: Определение конца строки

Вождь пишет:
aequit пишет:

...Если изменяю код из 9 сообщения...то макрос выполняется только до...Как заставить его продолжать работу?...

Откуда ж я знаю, не видя ВАШЕГО кода smile
Хотя бы ВАШИ значения what и forwhat сообщите.

Sub test1()
   SimpleReplaceAtEndOfLine1 "([Нн]а)( )", "\1^s" 
End Sub
Sub SimpleReplaceAtEndOfLine1(what, forwhat)
    With Selection
        .SetRange 0, 0
        With .Find
            .ClearFormatting
            .Text = what
            .Replacement.ClearFormatting
            .Replacement.Text = forwhat
            .Forward = True
            .Wrap = wdFindStop
            .MatchCase = False
            .MatchWildcards = True
            Do While .Execute(Replace:=wdReplaceNone)
Dim R As Word.Range
Dim EOL As Boolean
Dim N&
                Set R = Selection.Range
                N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
                EOL = Selection.IPAtEndOfLine
                R.Select
                If (N = 1) And EOL Then
                    Selection.Collapse Direction:=Word.wdCollapseStart
                    .Execute Replace:=wdReplaceOne
                Else
                    Selection.Collapse Direction:=Word.wdCollapseEnd
                End If
            Loop
        End With
    End With
End Sub

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

20

Re: Определение конца строки

Для заданной области и подстановочных знаков, где-то так:

Sub test1()
    ActiveDocument.ActiveWindow.View.Type = wdPrintView
    'ActiveDocument.Range(0, 0).Select
    SimpleReplaceAtEndOfLine1 Selection.Range, "(<[Нн]а)([ ]@<)", "\1^s"
End Sub

Sub SimpleReplaceAtEndOfLine1(FindRange As Range, What As String, ForWhat As String)
Dim R As Word.Range
Dim EOL As Boolean
Dim N As Long
    Set R = FindRange.Duplicate
    R.Collapse Direction:=wdCollapseStart
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = What
        .Replacement.Text = ForWhat
    End With
    Do While R.End < R.StoryLength - 1
        R.Collapse Direction:=wdCollapseEnd
        R.Find.Execute Replace:=wdReplaceNone
        If R.Find.Found <> True Then Exit Do
        If FindRange.Start < FindRange.End Then
            If R.InRange(FindRange) <> True Then Exit Do
        End If
        ' обработка
        R.Select
        N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
        EOL = Selection.IPAtEndOfLine
        If (N = 1) And EOL Then
            R.Collapse Direction:=wdCollapseStart
            R.Find.Execute Replace:=wdReplaceOne
        End If
    Loop
End Sub

Учтите, что после вставки неразрывного, ваше НА перескочит на следующую строку. Значит, концом строки может стать другое "НА", что стояло перед этим НА. НАдеюсь понятно smile

Макросы под заказ и готовый пакет - mtdmacro.ru

21

Re: Определение конца строки

Вот теперь работает с Wildcards и только вы нужном месте, не лезет по всему документу, спасибо!

22

Re: Определение конца строки

Вождь, спасибо большое!
Немножко переработал Ваш код, дополнив его справочником предлогов (в массиве arrWhat, однобуквенные слова там же, в конце) трёхкратным прогоном макроса и проверкой на выделение (останавливает, если обрабатываемый текст не выделен). Надеюсь пригодится народу.
Я - дилетант, потому код не эталонный, возможна критика за неэффективные или некрасивые решения.

Sub PerenosPredlogov()    ActiveDocument.ActiveWindow.View.Type = wdPrintView    'ActiveDocument.Range(0, 0).Select    SimpleReplaceAtEndOfLine1 Selection.Range, "", "\1^s"

End Sub

Sub SimpleReplaceAtEndOfLine1(FindRange As Range, What As String, ForWhat As String)
If FindRange.Duplicate = "" Then
MsgBox "Выделите текст!", vbInformation, "Обработка невозможна!"
Exit Sub
End If
Dim R As Word.Range
Dim EOL As Boolean
Dim N As Long
Dim arrWhat
arrWhat = Array("(<[Нн]а)", "(<[Ии]ли)", "(<[Вв]о)", "(<[Вв]иду)", "(<[Вв]опреки)", "(<[Вв]след)", "(<[Вв]следствие)", "(<[Дд]ля)", "(<[Дд]о)", "(<[Ии]з)", "(<[Ии]з-за)", "(<[Зз]а)", "(<[Ии]сключая)", "(<[Кк]о)", "(<[Кк]роме)", "(<[Нн]а)", "(<[Мм]ежду)", "(<[Нн]ад)", "(<[Нн]е)", "(<[Оо]б)", "(<[Оо]бо)", "(<[Оо]коло)", "(<[Оо]т)", "(<[Пп]еред)", "(<[Пп]о)", "(<[Пп]од)", "(<[Пп]ред)", "(<[Пп]ри)", "(<[Пп]ро)", "(<[Пп]ротив)", "(<[Пп]ри)", "(<[а-яА-Яa-zA-Z]{1})")
Dim i As Integer
i = 1
For i = 1 To 3
    For Each mark In arrWhat
    Set R = FindRange.Duplicate
    R.Collapse Direction:=wdCollapseStart
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = mark & "([ ]@<)"
        .Replacement.Text = ForWhat
    End With
    Do While R.End < R.StoryLength - 1
        R.Collapse Direction:=wdCollapseEnd
        R.Find.Execute Replace:=wdReplaceNone
        If R.Find.Found <> True Then Exit Do
        If FindRange.Start < FindRange.End Then
            If R.InRange(FindRange) <> True Then Exit Do
        End If
        ' обработка
        R.Select
        N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
        EOL = Selection.IPAtEndOfLine
        If (N = 1) And EOL Then
            R.Collapse Direction:=wdCollapseStart
            R.Find.Execute Replace:=wdReplaceOne
        End If
    Loop
    Next
i = i + 1
Next
End Sub

23

Re: Определение конца строки

Может прошлое сообщение отправилось на модерацию, а я этого не понял (тогда прошу простить), потому повторю.
Немножко переделал код Вождя. Добавлен справочник предлогов + однобуквенные слова (массив arrWhat), трёхкратный прогон всего кода. Не профессионал, делал под свои нужды, надеюсь пригодится

Sub PerenosPredlogov()
    ActiveDocument.ActiveWindow.View.Type = wdPrintView
    'ActiveDocument.Range(0, 0).Select
    SimpleReplaceAtEndOfLine1 Selection.Range, "", "\1^s"

End Sub

Sub SimpleReplaceAtEndOfLine1(FindRange As Range, What As String, ForWhat As String)
If FindRange.Duplicate = "" Then
MsgBox "Выделите текст!", vbInformation, "Обработка невозможна!"
Exit Sub
End If
Dim R As Word.Range
Dim EOL As Boolean
Dim N As Long
Dim arrWhat
arrWhat = Array("(<[Нн]а)", "(<[Ии]ли)", "(<[Вв]о)", "(<[Вв]иду)", "(<[Вв]опреки)", "(<[Вв]след)", "(<[Вв]следствие)", "(<[Дд]ля)", "(<[Дд]о)", "(<[Ии]з)", "(<[Ии]з-за)", "(<[Зз]а)", "(<[Ии]сключая)", "(<[Кк]о)", "(<[Кк]роме)", "(<[Нн]а)", "(<[Мм]ежду)", "(<[Нн]ад)", "(<[Нн]е)", "(<[Оо]б)", "(<[Оо]бо)", "(<[Оо]коло)", "(<[Оо]т)", "(<[Пп]еред)", "(<[Пп]о)", "(<[Пп]од)", "(<[Пп]ред)", "(<[Пп]ри)", "(<[Пп]ро)", "(<[Пп]ротив)", "(<[Пп]ри)", "(<[а-яА-Яa-zA-Z]{1})")
Dim i As Integer
i = 1
For i = 1 To 3
    For Each mark In arrWhat
    Set R = FindRange.Duplicate
    R.Collapse Direction:=wdCollapseStart
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = mark & "([ ]@<)"
        .Replacement.Text = ForWhat
    End With
    Do While R.End < R.StoryLength - 1
        R.Collapse Direction:=wdCollapseEnd
        R.Find.Execute Replace:=wdReplaceNone
        If R.Find.Found <> True Then Exit Do
        If FindRange.Start < FindRange.End Then
            If R.InRange(FindRange) <> True Then Exit Do
        End If
        ' обработка
        R.Select
        N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
        EOL = Selection.IPAtEndOfLine
        If (N = 1) And EOL Then
            R.Collapse Direction:=wdCollapseStart
            R.Find.Execute Replace:=wdReplaceOne
        End If
    Loop
    Next
i = i + 1
Next
End Sub

24

Re: Определение конца строки

Переделал код. Теперь словарь на виду (можно редактировать), и код отрабатывает правильно. Добавил подсчёт переносов, отображение прогресса (в статус баре) и финальное сообщение.Советую добавлять код в шаблон Normal, чтобы был доступен во всех документах.

Dim RC As Integer
Sub PerenosPredlogov()
    If VBA.Len(Selection.Range.Text) = 0 Then
    MsgBox "Выделите текст!", vbInformation, "Обработка невозможна!"
    Exit Sub
    End If
ActiveDocument.ActiveWindow.View.Type = wdPrintView
Application.ScreenUpdating = False
Dim FRange As Word.Range
Set FRange = Selection.Range
Dim arrWhat
Dim What$, i As Byte, p%, h%, prog%
'список членов предложения для переноса
    arrWhat = Array(0, "на", "во", "виду", "вопреки", "вслед", "для", "до", "из", "из-за", "за", "ко", "кроме", "на", "между", _
"над", "не", "об", "обо", "около", "от", "перед", "по", "под", "пред", "при", "про", "против", "со", "то", "да", "даже", _
"едва", "если", "затем", "либо", "когда", "как", "однако", "отчего", "перед", "пока", "после", "потому", "так", "также", "тем", _
"тоже", "тогда", "хотя", "чем", "что", "чтоб", "чтобы", "не", "ни", "это", "или") ', "поскольку", "исключая", "вследствие", "притом", "причем")
'переменные для отображения прогресса
p = 0
h = (UBound(arrWhat) + 1) * 3
prog = 0
RC = 0
Application.StatusBar = "Выполнено: 1 %" & ". Количество переносов: " & RC
i = 1
For i = 1 To 3
    For Each mark In arrWhat
        If mark <> 0 Then
        What = "(<[" & UCase(Left(mark, 1)) & Left(mark, 1) & "]" & Mid(mark, 2) & ")([ ]@<)" 'обработка предлогов для regex
        Else
        What = "(<[а-яА-Яa-zA-Z]{1})([ ]@<)" 'одиночные символы
        End If
        SimpleReplaceAtEndOfLine1 FRange, What, "\1^s"
        'счёт прогресса
        p = p + 1
        prog = p / h * 100
        Application.StatusBar = "Выполнено: " & prog & "%" & ". Количество переносов: " & RC
     Next
DoEvents
Next i
MsgBox "Выполнено! " & " Количество переносов: " & RC
Application.ScreenUpdating = True
End Sub
Sub SimpleReplaceAtEndOfLine1(FindRange As Range, What As String, ForWhat As String)
Dim R As Word.Range
Dim EOL As Boolean
Dim N As Long
Set R = FindRange.Duplicate
R.Collapse Direction:=wdCollapseStart
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = What
        .Replacement.Text = ForWhat
    End With
        ' поиск
        Do While R.End < R.StoryLength - 1
            R.Collapse Direction:=wdCollapseEnd
            R.Find.Execute Replace:=wdReplaceNone
            If R.Find.Found <> True Then Exit Do
            If FindRange.Start < FindRange.End Then
                If R.InRange(FindRange) <> True Then Exit Do
            End If
            ' обработка
            R.Select
            N = Selection.EndOf(Unit:=Word.wdLine, Extend:=Word.wdMove)
            EOL = Selection.IPAtEndOfLine
            If (N = 1) And EOL Then
                R.Collapse Direction:=wdCollapseStart
                R.Find.Execute Replace:=wdReplaceOne
                RC = RC + 1
            End If
        DoEvents
        Loop
End Sub

25

Re: Определение конца строки

Столкнулся с неправильной работой процедуры SimpleReplaceAtEndOfLine1 в случае, если после предлога в конце строки стоит кавычка. Не срабатывает, если, например, в конце строки стоит предлог