Тема: Макрос вгонки/выгонки коротких концевых строк абзацев
Идея заключается в том чтобы найти вот такие непомещающиеся
строки.
И по возможности загнать их в предыдущюю строку за счет сжатия
межсимвольного интервала. Слышал о подобных макросах, но не
смог найти, поэтому написал свой вариант на коленке. 
Sub Макрос3()
Dim a As Long
Dim b As Long
Dim c As Integer
Dim d As Byte
Dim flag As Boolean
flag = True
Do While flag = True
Selection.Paragraphs(1).Range.Select
' начинаем с текущего абзаца
a = Selection.Paragraphs(1).Range.Start
Selection.EndKey
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
b = Selection.Range.Start
c = Selection.Characters.Count
If (a <> b) And (c < 10) Then
' не трогаем нормальные абзацы и однострочные
If Selection.Paragraphs(1).Range.Font.Spacing <= -0.4 Then
Selection.Paragraphs(1).Range.Font.Spacing = 0
Selection.Paragraphs(1).Range.Font.Color = wdColorAqua
' если не сжимается то выделить
Else
Selection.Paragraphs(1).Range.Font.Spacing = _
Selection.Paragraphs(1).Range.Font.Spacing + -0.05
Selection.HomeKey
' сжимаем
End If
End If
d = Selection.Move(Unit:=wdWord, Count:=2)
If d < 2 Then flag = False
' ловим конец документа
Loop
End SubВ принципе макрос работает, но хотелось не только делать
вгонку строк, но и выгонку. В ручную выгонку делаю так, поднимаюсь
на строку выше засчет разрыва строки, спускаю одно слово
и визуально проверяю чтобы между словами небыло больших дыр и тд.
Принимаются любые идеи способствующие улучшить макрос
или может найдется уже готовое решение, в любом случае буду благодарен
за содействие.
Отредактировано admin (04.03.2010 11:15:50)
