1 Тема от qwest48

  • qwest48
  • рядовой
  • Неактивен
  • Зарегистрирован: 04.03.2010
  • Сообщений: 4

Тема: Макрос вгонки/выгонки коротких концевых строк абзацев

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

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)

2 Ответ от Вождь

  • Макрос вгонки/выгонки коротких концевых строк абзацев
  • Вождь
  • Модератор
  • Неактивен
  • Зарегистрирован: 07.01.2010
  • Сообщений: 745
  • Поблагодарили: 181

Re: Макрос вгонки/выгонки коротких концевых строк абзацев

Пару советов:

1. Вам очень поможет сфункция FitTextWidth.
Например: Selection.FitTextWidth = CentimetersToPoints(10) вжимает/растягивает выбранный текст до 10 см. за счет изменения межсимвольных интервалов.

2. Рассчитать ширину текста в строке и самих строк поможет функция Information.
Например: Selection.Information(wdHorizontalPositionRelativeToTextBoundary) возвращает расстояние от начала строки до начала выделенной области.

Рассчитайте нужную ширину с помощью Information  и примените FitTextWidth.

Макросы под заказ и готовый пакет - mtdmacro.ru

СайтВождь

3 Ответ от qwest48

  • qwest48
  • рядовой
  • Неактивен
  • Зарегистрирован: 04.03.2010
  • Сообщений: 4

Re: Макрос вгонки/выгонки коротких концевых строк абзацев

Большое спасибо Вождь, советы действительно нуж-
ные!
Продолжу эксперименты по борьбе с короткими строка-
ми. big_smile