Помогите пожалуйста с макросом

andruq · 17 июля 2025, 00:43

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

Спойлер

Sub removelinebreak()
Dim rng As Range
Dim para As Paragraph

Dim ur As UndoRecord
Set ur = Word.Application.UndoRecord
ur.StartCustomRecord "removelinebreak"

Set rng = Selection.Range

With rng.Find
.ClearFormatting
.ClearAllFuzzyOptions
.Text = vbCr
.Wrap = wdFindStop
.Forward = True
.Execute , , , , , , , , , " ", wdReplaceAll
.Text = vbLf
.Execute , , , , , , , , , " ", wdReplaceAll
.Execute Chr(9), , , , , , , , , " ", wdReplaceAll
.Execute Chr(11), , , , , , , , , " ", wdReplaceAll
.Execute ". ^p", , , , , , , , , ".^p", wdCollapseEnd
.Execute " ", , , , , , , , , " ", wdReplaceAll
.ClearFormatting
.ClearAllFuzzyOptions
End With
ur.EndCustomRecord
' ' Loop through each paragraph in the range
' For Each para In rng.Paragraphs
' Debug.Print para.Range.Text
' If Right(para.Range.Text, 1) = vbCr Or Right(para.Range.Text, 2) = vbLf Then
' para.Range.Collapse Direction:=wdCollapseEnd
' para.Range.MoveStart Unit:=wdCharacter, Count:=-1
' para.Range.Delete
' End If
' Next para

End Sub

[свернуть]

Суть в следующем: при его запуске он соединяет всё в один абзац, а нужно , чтобы выделенные абзацы сохранялись, причем абзацы делаются табуляцией в исходном документе при помощи CTRL+TAB - так сделано специально. Всю голову сломал, заранее спасибо!

Администратор · 17 июля 2025, 08:53

Напишите задание без упоминания имеющегося макроса.
Просто опишите задание обычными словами без использования программных терминов. У вас есть документ, на основе этого документа поясните, что нужно сделать.

andruq · 17 июля 2025, 12:49

Спасибо за предложенную помощь!

Имеем исходный текст, в котором каждая строчка заканчивается абзацем, а так же присутствует мусор в виде лишних пробелов. Красное выделение - это абзацы, которые нужно сохранить (3 абзаца в качестве примера), а так же сделать их при помощи табуляции. При этом к тексту необходимо применить следующее форматирование:
- шрифт times new roman 10.5
- выравнивание по ширине
- начертание обычное
- междустрочный интервал 1.15
- регистр букв: все прописные

Заранее спасибо!

Администратор · 17 июля 2025, 12:52

Выложите файл, как должно быть после макроса.

andruq · 17 июля 2025, 18:14

Вот

Администратор · 17 июля 2025, 20:10

В этой задаче не всё так просто: в конце строки может быть дефис. Дефис нужно удалить, но дефис может быть частью сложного слова: кое-как. Если в этом слове удалить дефис, то получится коекак.

andruq · 17 июля 2025, 20:58

А если упростить задачу, например заменить символ абзаца простым пробелом, а там где 4 и пять пробелов (перед новым абзацем) заменить на табуляцию.
Я это пробовал делать по средствам замены. всё вроде получалось, но хотелось бы всё уместить всё в один макрос

andruq · 17 июля 2025, 22:06

Вот. что у меня получилось, без форматирования текста

Спойлер

Sub Макрос3()
'
' Макрос3 Макрос
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.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
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "
.Replacement.Text = " ^t"
.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 = " ^t"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " ^t"
.Replacement.Text = " ^p^t"
.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 = " {2;}"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

[свернуть]

andruq · 17 июля 2025, 23:22

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

Спойлер

Sub Макрос1()
'
' Макрос1 Макрос
'
'
Selection.Style = ActiveDocument.Styles("Без интервала")
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
Selection.ParagraphFormat.LineSpacing = LinesToPoints(1.15)
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10.5
Selection.Range.Case = wdUpperCase
Selection.Font.UnderlineColor = wdColorAutomatic
Selection.Font.Underline = wdUnderlineNone
Selection.Font.Italic = False
Selection.Font.Bold = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.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
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "
.Replacement.Text = " ^t"
.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 = " ^t"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " ^t"
.Replacement.Text = " ^p^t"
.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 = " {2;}"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
End Sub

[свернуть]

Администратор · 18 июля 2025, 10:33

Цитата:
например заменить символ абзаца простым пробелом

Но в ответе #5 другая проблема: обработка дефиса, а не обработка символа абзаца. Прочитайте ещё раз ответ #5. В нём ни слова нет про символ абзаца. Зачем вы написали про символ абзаца? Не понимаете разницу между символом абзаца и дефисом?

andruq · 18 июля 2025, 10:48

Это я все понимаю, как будет выглядеть такой макрос, если опустить дефис, мне это не так важно. И самое главное, как сделать так, чтобы работа макроса распространялась только на выделенный фрагмент текста. Когда я его записываю, все работает, как только применяю на выделенный фрагмент, он применяет все не только на выделенный фрагмент текста, но и ниже. Может есть какой-то оператор. Спасибо

Администратор · 18 июля 2025, 10:50

И что делать макросу с дефисом, который в конце строки? Удалить дефис? И слова склеятся? Например, слово "что-нибудь" будет "чтонибудь".

andruq · 18 июля 2025, 10:59

Давайте попробуем просто удалить его. Сейчас главное мне понять, как применять его только она выделенный фрагмент, потому-что это большая проблема

Администратор · 18 июля 2025, 11:51

Написал вам письмо на почту. Написал именно на почту, а не на форум.