Форум по VBA и MS Office

Word => Макросы в Word => Тема начата: Anton от 31 мая 2017, 14:00

Название: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Anton от 31 мая 2017, 14:00
Добрый день еще раз. Замучился с одним текстом, где есть много абзацев со сжатым или расширенным шрифтом (Шрифт - Дополнительно - Интервал - разряженный или уплотненный). А весь сразу текст изменить нельзя, предпочтительно изменять и подгонять абзацы, у которых уже изменен интервал у шрифта.

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


Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Администратор от 31 мая 2017, 18:01
В пределах одного абзаца у символов может быть разное сжатие? Например, у одно символа уплотнение 0,1, у другого 0,2? Или внутри одного абзаца у всех символов сжатие одинаковое?
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Anton от 31 мая 2017, 19:02
Я посмотрел - у меня почти все (в рабочем документе, например, только один с разным сжатием) либо сжаты либо расширены.
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Администратор от 31 мая 2017, 19:24
Вы так и не ответили на вопрос. Я про другое спрашивал. Я про расширение не спрашивал.
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Anton от 31 мая 2017, 20:00
Одинаковое.
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Администратор от 31 мая 2017, 20:03
В абзаце с расширением тоже у всех символов одинаковое расширение?
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Anton от 31 мая 2017, 20:14
Да, тоже одинаковое.
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Администратор от 31 мая 2017, 22:02
Макрос
Sub Макрос()

    Dim par As Paragraph, spacing As Single
   
    '1. Отключение монитора (может это ускорит макрос и не будет мерцать).
    Application.ScreenUpdating = False
   
    '2. Цикл по всем абзацам в основной части файла.
    For Each par In ActiveDocument.Paragraphs
        ' Запись интервала в переменную, чтобы ускорить макрос, чтобы
            ' не использовать объекты, а использовать переменную.
        spacing = par.Range.Font.spacing
        ' Если во фрагменте разные интервалы, то возвращается число "9999999".
        If spacing <> 9999999 Then
            ' Если интервал разреженный, то число положительное.
            If spacing > 0 Then
                par.Range.Shading.BackgroundPatternColor = -654246042
            ' Если интервал уплотнённый, то число отрицательное.
            ElseIf spacing < 0 Then
                par.Range.Shading.BackgroundPatternColor = -671023258
            End If
        End If
    Next par
   
    '3. Включение монитора.
    Application.ScreenUpdating = True
   
    '4. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub
[свернуть]
Название: Re: Word Макрос: Закрасить сжатые и расширенные абзацы
Отправлено: Anton от 31 мая 2017, 23:37
Все сработало на ура!

Большое-пребольшое спасибо!