Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 03.07.2019, 09:13   #1
Berton3
Новичок
 
Регистрация: 03.07.2019
Сообщений: 1
Репутация: 10
Восклицание Довести макрос до ума

Всем привет!
Имеется макрос для замены пробелов после предлогов в конце строк на неразрывные.
Не хватает знаний в данной области чтобы довести его до ума. Прошу направить на путь истинный.

Код:
Sub KILLPREDLOG()
    ActiveDocument.ActiveWindow.View.Type = wdPrintView
    'ActiveDocument.Range(0, 0).Select
    SimpleReplaceAtEndOfLine1 Selection.Range, "(<[А-я])([ ]@<)", "\1^s" 
' эта строка отрабатывает полностью свои варианты
    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
Berton3 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Довести программу до ума laucher Помощь студентам 2 15.10.2016 20:51
довести до ума ! Morgusha JavaScript, Ajax 3 18.04.2013 22:25
Довести до ума БД в delphi Харламов Юрий Помощь студентам 6 28.12.2010 03:34
Помогите довести до ума andresan Assembler 2 27.11.2009 08:46


20:58.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.