Всем макросы, которые ниже, не уменьшают пустые абзацы в таблице.
Поиск во всём файле. Обрабатывается только основной текст (сноски и т.д. не обрабатываются).
Не уменьшаются пустые абзацы, которые в одном экземпляре, такое может быть, если пустой абзац находится после таблицы.
Макрос
Sub Макрос()
Dim find_rng As Range, find As find
'1. Созднаие объектов, которые будут искать.
Set find_rng = ActiveDocument.Range(0, 0)
Set find = find_rng.find
'2. Отключение монитора.
Application.ScreenUpdating = False
'3. Настройка поиска.
find.text = "^13{2;}"
find.MatchWildcards = True
find.Wrap = wdFindStop
'4. Изменение шрифта.
Do While find.Execute = True
' Если абзац в таблице, то установка невидимого курсора за таблицей.
If find_rng.Information(wdWithInTable) = True Then
find_rng.SetRange Start:=find_rng.Tables(1).Range.End, End:=find_rng.Tables(1).Range.End
' Если абзац не в таблице.
Else
' Убирание из найденного фрагмента первого абзаца, если первый абзац непустой.
If find_rng.Paragraphs(1).Range.Characters.Count <> 1 Then
find_rng.MoveStart Unit:=wdParagraph, Count:=1
End If
' Изменение шрифта.
find_rng.Font.Size = 8
' Превращение рейнджа в точку вставки и установка точки вставки справа от найденного фрагмента.
find_rng.Collapse Direction:=wdCollapseEnd
End If
Loop
'5. Включение монитора.
Application.ScreenUpdating = True
'6. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Поиск в выделенном фрагменте. Работает во всех частях файла: в основном тексте, сносках и т.д.
Не уменьшаются пустые абзацы, которые в одном экземпляре, такое может быть, если пустой абзац находится после таблицы.
Не уменьшаются абзацы, которые находятся в конце выделения, если после выделения сразу есть ещё пустые абзацы.
Макрос
Sub Макрос()
Dim rng_find As Range, fnd As Find, FirstEntry As Boolean, SelStart As Long, SelEnd As Long
'1. Отключение монитора.
Application.ScreenUpdating = False
'2. Запоминание начала и конца выделения.
SelStart = Selection.Start
SelEnd = Selection.End
'3. Создание объектов, которые будут искать.
Set rng_find = Selection.Range.Duplicate
rng_find.Collapse Direction:=wdCollapseStart
Set fnd = rng_find.Find
'4. Настройка поиска.
fnd.text = "^13{2;}"
fnd.MatchWildcards = True
' wdFindContinue - иначе поиск останавливался раньше, например, когда в начале был абзац, а затем таблица.
fnd.Wrap = wdFindContinue
FirstEntry = True
'5. Поиск.
Do While fnd.Execute = True
' Если это первое вхождение.
If FirstEntry = True Then
FirstEntry = False
' Если найдено за пределами выделенного фрагмента.
If (rng_find.Start < SelStart) Or (rng_find.End > SelEnd) Then
Exit Do
End If
' Если это последующие вхождения.
Else
If (rng_find.Start <= SelStart) Or (rng_find.End > SelEnd) Then
Exit Do
End If
End If
' Если абзац в таблице, то установка невидимого курсора за таблицей.
If rng_find.Information(wdWithInTable) = True Then
rng_find.SetRange Start:=rng_find.Tables(1).Range.End, End:=rng_find.Tables(1).Range.End
' Если абзац не в таблице.
Else
' Убирание из найденного фрагмента первого абзаца, если первый абзац непустой.
If rng_find.Paragraphs(1).Range.Characters.Count <> 1 Then
rng_find.MoveStart Unit:=wdParagraph, Count:=1
End If
' Изменение шрифта.
rng_find.Font.Size = 8
End If
Loop
'6. Включение монитора.
Application.ScreenUpdating = True
'7. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Поиск в выделенном фрагменте. Работает во всех частях файла: в основном тексте, сносках и т.д.
Этот макрос уменьшает одиночные абзацы и абзацы, которые находятся в конце выделения, если после выделения сразу есть ещё пустые абзацы.
Макрос
Sub Макрос()
Dim par As Paragraph
'1. Отключение монитора.
Application.ScreenUpdating = False
'2. Изменение размера шрифта у пустых абзацев.
For Each par In Selection.Paragraphs
If par.Range.Information(wdWithInTable) = False Then
If par.Range.Characters.Count = 1 Then
par.Range.Font.Size = 8
End If
End If
Next par
'3. Включение монитора.
Application.ScreenUpdating = True
'4. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Отличие двух последних макросов в скорости работы. Метод "Find" быстрее работает, чем цикл по всем абзацам.