Выделение всех вытесненных (переполненных) текстовых фреймов

[rams84]

Хочеться быстро применить стиль для всех вытеснных (переполнных) текстовых фреймов. Для этого соответственно нужно бы их выделить все. Может есть такая "кнопка"
А может кто подскажет макрос для него? плиз

 

[lev]

Ответ: Выделение всех вытеснных (переполнных) текстовых фреймов

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

Sub SelectOverflowed()
  Dim s As Shape, c As New ShapeRange
  For Each s In ActiveDocument.ActivePage.FindShapes(, cdrTextShape)
    If s.Text.Type = cdrParagraphText Then
      If s.Text.Overflow Then c.Add s
    End If
  Next s
  c.AddToSelection
End Sub

 

[rams84]

Ответ: Выделение всех вытеснных (переполнных) текстовых фреймов

Спвсибо, может что и получу в итоге.
Применя стиль по очередно, сначало уменьшив на один кегель. Затем поискав еще переполнения, уменьшив еще на один кегель и т.д. (это про гарантии)

 

[lev]

Ответ: Выделение всех вытеснных (переполнных) текстовых фреймов

Проще это делать в макросе, но не перебирая стили, а просто снижая размер шрифта, до исчезновения переполнения.

 

[rams84]

Ответ: Выделение всех вытесненных (переполненных) текстовых фреймов

Спасибо lev. Все работает. Очень помогли.
Экономлю целый рабочий день теперь.

Вот бы еще тоже самое в индюке в таблицах Но это уже в другой теме.

 

[lev]

Ответ: Выделение всех вытеснных (переполнных) текстовых фреймов

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

Sub NoOverflow()
  Dim s As Shape
  ActiveDocument.BeginCommandGroup "Remove Overflow"
  Decrement = 0.5
  MinSize = 5
  For Each s In ActiveDocument.ActivePage.FindShapes(, cdrTextShape)
    If s.Text.Type = cdrParagraphText Then
      With s.Text
        While .Overflow And .Story.Size > MinSize
          .Story.Size = .Story.Size - Decrement
        Wend
      End With
    End If
  Next s
  ActiveDocument.EndCommandGroup
End Sub