Только текст | Текст с изображениями

Форум по VBA и MS Office

Word => Макросы в Word => Тема начата: Посетитель 04.04.2024 от 05 апреля 2024, 13:53

Название: Оптимизация кода
Отправлено: Посетитель 04.04.2024 от 05 апреля 2024, 13:53
Нашел на просторах интернета интересный макрос, который будет полезен в определенных кругах. По крайней мере я его по работе точно буду использовать.
Но кажется мне, что код можно оптимизировать, по крайней мере в части замены нескольких пробелов на один. Тем более, что приведенный код может менять только 4 пробела, а нужно, чтобы менял любое количество пробелов подряд на один пробел.
В общем и целом макрос работает, но если кто-то готов посодействовать с оптимизацией, я буду признателен. И, думаю, не только я :)

Спойлер
Sub Причесывание()

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    'Заменяет двойной пробел на одинарный
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
      With Selection.Find
      'Заменяет тройной пробел на одинарный
        .Text = "   "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
      With Selection.Find
      'Заменяет четверной пробел на одинарный
        .Text = "    "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Убирает пробел перед запятой
        .Text = " ,"
        .Replacement.Text = ","
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
      Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Убирает пробел после скобки
        .Text = "( "
        .Replacement.Text = "("
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Заменяет прописную ё на е
        .Text = "ё"
        .Replacement.Text = "е"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
     Selection.Find.Execute Replace:=wdReplaceAll
       With Selection.Find
       'Заменяет заглавную Ё на Е
        .Text = "Ё"
        .Replacement.Text = "Е"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Удаляет пробел перед символом абзаца
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Удаляет пробел после символа абзаца
        .Text = "^p "
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Заменяет абзац табуляцией на обычный абзац
        .Text = "^p^t"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Заменяет короткое тире на среднее тире, если между пробелами
        .Text = " - "
        .Replacement.Text = " ^0150 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
    'Заменяет длинное тире на среднее тире
        .Text = "^0151"
        .Replacement.Text = "^0150"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
      With Selection.Find
      'Заменяет неразрывный пробел на обычный
        .Text = "^0160"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
      With Selection.Find
      'Заменяет кавычки лапки на кавычки ёлочки левые
        .Text = """"
        .Replacement.Text = "^0171"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
     With Selection.Find
     'Заменяет кавычки лапки на кавычки ёлочки правые
        .Text = """"
        .Replacement.Text = "^0187"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
[свернуть]
Название: Оптимизация кода
Отправлено: Администратор от 05 апреля 2024, 14:07
Вот так можно заменить любое количество пробелов на один.
Только этот код используйте после кода, который заменяет неразрывные пробелы на обычные, иначе могут появиться двойные пробелы.

With Selection.Find
    .Text = " {2;}"
    .Replacement.Text = " "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With
Название: Оптимизация кода
Отправлено: Посетитель 04.04.2024 от 05 апреля 2024, 17:35
Вы очень помогли.
Правда, если честно, я думал, что макрос написали макрорекордером и потом чуток отшлифовали.
Очень уж много повторяется
.Replacement.Text = "."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
Мне казалось, что это всё можно залить в какой-нибудь else и сильно сжать тело кода.
Кстати, кусок кода с неразрывными пробелами, как выяснилось, не работал. Я его перенес выше и всё исправилось.
Еще раз спасибо за помощь
Только текст | Текст с изображениями