Word Макросы: Как применить стиль ко всему тексту, кроме таблиц и рисунков?

[Anton]

Добрый день!
А можно ли как-то макросом выделить все в документе кроме таблиц и рисунков?

[Администратор]

Обычно выделять не нужно, а нужно просто что-то сделать с некоторыми элементами.
Что вы планируете сделать с выделенными элементами?

[Anton]

Я хотел назначить стиль "Обычный" всему тексту сразу, но не трогать таблицы и рисунки.

[Администратор]

В ворде вообще нельзя выделить несмежные фрагменты.
Можно только сделать макрос, который будет двигаться по всем абзацам в файле. Если абзац не в таблице, если в абзаце нет рисунка "InlineShape", то макрос применит к абзацу стиль "Обычный".

[Anton]

Я понял. Если поможете сделать такой макрос, буду рад.

[Администратор]

Макрос

Sub Макрос()

    Dim par As Paragraph
   
   
    '1. Отключение монитора (может это ускорит макрос).
    Application.ScreenUpdating = False
   
    '2. Цикл по всем абзацам.
    For Each par In ActiveDocument.Paragraphs
        '1) Если абзац в таблице.
        If par.Range.Information(wdWithInTable) = True Then
            GoTo metka_NextPar
        End If
        '2) Если в абзаце рисунок типа "InlineShape".
        If par.Range.InlineShapes.Count <> 0 Then
            GoTo metka_NextPar
        End If
        '3) Применение стиля к абзацу.
        par.Range.Style = "Обычный"
metka_NextPar:
    Next par
       
    '3. Включение монитора.
    Application.ScreenUpdating = True
   
    '4. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[Anton]

Спасибо Вам! Выручили!

[Администратор]

Эта версия быстрее должна работать, т.к. не просматриваются все абзацы таблицы.

Макрос

Sub Макрос()

    Dim par As Paragraph
   
   
    '1. Отключение монитора (может это ускорит макрос).
    Application.ScreenUpdating = False
   
    '2. Присваивание имени "par" первому абзацу.
    Set par = ActiveDocument.Paragraphs(1)
   
    '3. Цикл по абзацам.
    Do
        '1) Если абзац в таблице.
        If par.Range.Information(wdWithInTable) = True Then
            ' Присваивание имени "par" абзацу, который находится после таблицы.
            Set par = par.Range.Tables(1).Range.Paragraphs.Last.Next
            GoTo metka_NextPar
        End If
       
        '2) Если в абзаце рисунок типа "InlineShape".
        If par.Range.InlineShapes.Count <> 0 Then
            ' Присваивание имени "par" следующему абзацу.
            Set par = par.Next
            GoTo metka_NextPar
        End If
       
        '3) Применение стиля к абзацу.
        par.Range.Style = "Обычный"
        Set par = par.Next
       
metka_NextPar:

        '4) Если просмотрены все абзацы.
        If par Is Nothing Then
            Exit Do
        End If
       
    Loop
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[Anton]

Спасибо!
Вот только на другом файле не работает, хотя даже и вручную у меня стиль не устанавливается, только очищение формата помогает. Не понимаю, почему так. Помогите разобраться пожалуйста. Пример приложил.

[вложение удалено администратором]

[Администратор]

Не знаю, почему так. Возможно брак в ворде. Значит нужно сначала очищать формат, а затем применять нужный стиль.

[Администратор]

Это происходит, если к абзацу применён стиль знака. Стили подразделяются на стили абзаца, знака и ещё другие есть.
Почему-то если у абзаца стиль знака, то стиль абзаца нельзя применить.

[Anton]

Как быть? Можно ли доработать макрос так, чтобы он очищал сначала формат, а потом применял стиль?

[Администратор]

Макрос

Sub Макрос()

    Dim par As Paragraph
   
   
    '1. Отключение монитора (может это ускорит макрос).
    Application.ScreenUpdating = False
   
    '2. Присваивание имени "par" первому абзацу.
    Set par = ActiveDocument.Paragraphs(1)
   
    '3. Цикл по абзацам.
    Do
        '1) Если абзац в таблице.
        If par.Range.Information(wdWithInTable) = True Then
            ' Присваивание имени "par" абзацу, который находится после таблицы.
            Set par = par.Range.Tables(1).Range.Paragraphs.Last.Next
            GoTo metka_NextPar
        End If
       
        '2) Если в абзаце рисунок типа "InlineShape".
        If par.Range.InlineShapes.Count <> 0 Then
            ' Присваивание имени "par" следующему абзацу.
            Set par = par.Next
            GoTo metka_NextPar
        End If
       
        '3) Применение стиля к абзацу.
        par.Range.Select
        Selection.ClearFormatting
        Selection.Style = "Обычный"
        Set par = par.Next
       
metka_NextPar:

        '4) Если просмотрены все абзацы.
        If par Is Nothing Then
            Exit Do
        End If
       
    Loop
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[Anton]

Да, все получилось. Небольшое изменение в коде, и все работает!
Пытаюсь сам что-то из примеров применять, тем более, что Вы подробно все комментируете, но пока ума и времени не хватает.
Спасибо Вам за терпение и помощь!