1

Тема: Окончить цикл макроса

Только начал знакомство с макросами. Пользую "Запись", а потом леплю чего-нить. Необходим макрос, который ищет параметры заголовка (в тексте это обычно "1 Заголовок", "2 Заголовок" или "1.1 Заголовок") и применяет к данному абзацу определённый стиль. С циклами я не освоился и мой прокручивает документ Over 1000000+ раз, т.к. условие соблюдается (меняется только стиль, а текст остаётся прежним). Подскажите пож, как его завершить при достижении конца документа?

Вот собсна текст:
Sub УстановитьВсеЗаголовки1Уровня()
' Работает до удаления лишних абзацев
    Selection.Find.ClearFormatting
    Do
    With ActiveDocument.Range.Find
        .Text = "^0013[0-9]^0032"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.MoveEndUntil cset:=Chr(13)
    Selection.Style = ActiveDocument.Styles("Headline1")
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
End Sub

И ещё такой бонусный вопрос - если макрос применять к документу, который поступает - он работает, но если я удалю лишние абзацы, то перестаёт. Это значит, что при удалении лишних абзацев необходимо указывать перед моим текстом поиска ещё и что-нибудь вроде *(любое число символов)? Или дело в другом?

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

2

Re: Окончить цикл макроса

Попробуйте так:

Sub Macro1()
    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Заголовок 1")
    Selection.find.Replacement.ClearFormatting
    Selection.find.Replacement.Font.Color = wdColorRed
    With Selection.find
        .Text = "(*[0-9A-Za-zА-яЁё])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.find.Execute Replace:=wdReplaceAll
End Sub

Макрос меняет цвет заголовков с именем стиля "Заголовок 1" на красный.
Цикл для замены по всему тексту не нужен.
Вместо цикла используется команда "Заменить все":

Selection.find.Execute Replace:=wdReplaceAll
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

3

Re: Окончить цикл макроса

Fck_This пишет:

Необходим макрос, который ищет параметры заголовка (в тексте это обычно "1 Заголовок", "2 Заголовок" или "1.1 Заголовок") и применяет к данному абзацу определённый стиль.

Видимо, вам следует перебрать все абзацы заголовков в документе. Как правило, такие абзацы имеют ненулевой атрибут OutlineLevel. Напр., можно было бы сделать так:
'----------------------------------------------------------------------
Sub ParseOutlineParagraphs()
Dim para as Paragraph
Dim pst As String
Dim ol As Long
For Each para In ActiveDocument.Paragraphs
    pst = para.range.Style.NameLocal
    ol = para.range.ParagraphFormat.OutlineLevel
    If (ol > 0) And (ol < 10) Then
        If ((Ucase$(pst) Like "*ЗАГОЛОВОК*)  Then
            'Обработка стиля абзаца
           para.style = "Style1"
        End If
    End If
Next
End Sub
'----------------------------------------------------------------------

4

Re: Окончить цикл макроса

Поправка:
'----------------------------------------------------------------------
Sub ParseOutlineParagraphs()
Dim para As Paragraph
Dim pst As String
Dim ol As Long
For Each para In ActiveDocument.Paragraphs
    pst = para.Style
    ol = para.Range.ParagraphFormat.OutlineLevel
    If (ol > 0) And (ol < 10) Then
        If (UCase$(pst) Like "*ЗАГОЛОВОК*") Then
            'Обработка абзаца
           para.Style = "Style1"
        End If
    End If
Next
End Sub
'----------------------------------------------------------------------

5

Re: Окончить цикл макроса

Alex_Gur пишет:

Попробуйте так:

Sub Macro1()
    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Заголовок 1")
    Selection.find.Replacement.ClearFormatting
    Selection.find.Replacement.Font.Color = wdColorRed
    With Selection.find
        .Text = "(*[0-9A-Za-zА-яЁё])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.find.Execute Replace:=wdReplaceAll
End Sub

Макрос меняет цвет заголовков с именем стиля "Заголовок 1" на красный.
Цикл для замены по всему тексту не нужен.
Вместо цикла используется команда "Заменить все":

Selection.find.Execute Replace:=wdReplaceAll

Я так понял, что ваш код основывается на поиске абзацев определённого стиля, но дело в том, что стили абзацам не заданы. Здесь вся сложность именно в том, что привязать можно только к тексту.  smile И стиль-то и нужно задать. Макрорекодер обычно использует такую "шляпу", при поиске и замене.

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

6

Re: Окончить цикл макроса

yshindin пишет:

Поправка:
'----------------------------------------------------------------------
Sub ParseOutlineParagraphs()
Dim para As Paragraph
Dim pst As String
Dim ol As Long
For Each para In ActiveDocument.Paragraphs
    pst = para.Style
    ol = para.Range.ParagraphFormat.OutlineLevel
    If (ol > 0) And (ol < 10) Then
        If (UCase$(pst) Like "*ЗАГОЛОВОК*") Then
            'Обработка абзаца
           para.Style = "Style1"
        End If
    End If
Next
End Sub
'----------------------------------------------------------------------

Вы явно ближе всего к истине) Но есть поправочка одна - текст заголовка может быть любой: "1 Кастрюля", "1.1 Ручка кастрюли", "1.2 Крышка кастрюли", "2 Лук репчатый".

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

7

Re: Окончить цикл макроса

Заглянул опять по ссылкам Гугла и осознал возможность сработать по маркеру "Библиография" или "Приложение А". Если кто-то надумает чего поумнее - буду весьма признателен (мало ли где-то маркера не окажется).

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

8

Re: Окончить цикл макроса

Вы явно ближе всего к истине) Но есть поправочка одна - текст заголовка может быть любой: "1 Кастрюля", "1.1 Ручка кастрюли", "1.2 Крышка кастрюли", "2 Лук репчатый".

Если вас интересуют заголовки вообще (в моем понимании - это абзацы с ненулевым уровнем OutlineLevel), то уберите строки

If (UCase$(pst) Like "*ЗАГОЛОВОК*") Then
      и
End If

либо замените их на анализ других атрибутов абзаца или стиля.

9

Re: Окончить цикл макроса

Fck_This пишет:

Вы явно ближе всего к истине) Но есть поправочка одна - текст заголовка может быть любой: "1 Кастрюля", "1.1 Ручка кастрюли", "1.2 Крышка кастрюли", "2 Лук репчатый".

Кстати, обратите внимание: в своем VBA-коде я не анализирую текст заголовка (который может быть любым), а анализирую стиль очередного абзаца.

10

Re: Окончить цикл макроса

yshindin пишет:
Fck_This пишет:

Вы явно ближе всего к истине) Но есть поправочка одна - текст заголовка может быть любой: "1 Кастрюля", "1.1 Ручка кастрюли", "1.2 Крышка кастрюли", "2 Лук репчатый".

Кстати, обратите внимание: в своем VBA-коде я не анализирую текст заголовка (который может быть любым), а анализирую стиль очередного абзаца.

На стиле нельзя основываться, т.к. стили не назначены. Документы разные приходят и уровень может быть и нулю равен sad

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

11

Re: Окончить цикл макроса

Fck_This пишет:

На стиле нельзя основываться, т.к. стили не назначены. Документы разные приходят и уровень может быть и нулю равен sad

Тогда пожалуйста дайте определение того, что в контексте вашего документа есть заголовок ))

12

Re: Окончить цикл макроса

yshindin пишет:
Fck_This пишет:

На стиле нельзя основываться, т.к. стили не назначены. Документы разные приходят и уровень может быть и нулю равен sad

Тогда пожалуйста дайте определение того, что в контексте вашего документа есть заголовок ))

Параметры текста и оступы могут быть абсолютно любыми, уровня у заголовка может не быть - им зачастую не назначают стиль. в 90% случаев это текст, только контекстуально отличающийся. И тем, что он пронумерован 1; 1.1; 1.1.1; 2; 2.1; 2.2; 3....... Вот такие пироги. smile

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

13

Re: Окончить цикл макроса

Fck_This пишет:

Параметры текста и оступы могут быть абсолютно любыми, уровня у заголовка может не быть - им зачастую не назначают стиль. в 90% случаев это текст, только контекстуально отличающийся. И тем, что он пронумерован 1; 1.1; 1.1.1; 2; 2.1; 2.2; 3....... Вот такие пироги. smile

Для облегчения решения вашей задачи я рекомендовал бы вести в документе нумерацию ваших заголовков таким образом, чтобы строка заголовка сразу была бы видна. Например, вы могли бы использовать поля {LISTNUM} или {SEQ} для ведения нумерации заголовков. Тогда бы при анализе в VBA-коде очередного абзаца можно было бы смотреть: если в данном абзаце есть поле LISTNUM в начале абзаца, то это абзац заголовка. И тогда применять к такому абзацу соответствующую обработку.
Другой подход - анализировать первое слово в абзаце по маске (с помощью оператора Like). Если это номер, отвечающий маске номера заголовка, то значит это абзац заголовка. Однако тут можно легко спутать абзац заголовка с обычным нумерованным абзацем.
В общем, пробуйте, успеха вам. ))

14

Re: Окончить цикл макроса

yshindin пишет:
Fck_This пишет:

Параметры текста и оступы могут быть абсолютно любыми, уровня у заголовка может не быть - им зачастую не назначают стиль. в 90% случаев это текст, только контекстуально отличающийся. И тем, что он пронумерован 1; 1.1; 1.1.1; 2; 2.1; 2.2; 3....... Вот такие пироги. smile

Для облегчения решения вашей задачи я рекомендовал бы вести в документе нумерацию ваших заголовков таким образом, чтобы строка заголовка сразу была бы видна. Например, вы могли бы использовать поля {LISTNUM} или {SEQ} для ведения нумерации заголовков. Тогда бы при анализе в VBA-коде очередного абзаца можно было бы смотреть: если в данном абзаце есть поле LISTNUM в начале абзаца, то это абзац заголовка. И тогда применять к такому абзацу соответствующую обработку.
Другой подход - анализировать первое слово в абзаце по маске (с помощью оператора Like). Если это номер, отвечающий маске номера заголовка, то значит это абзац заголовка. Однако тут можно легко спутать абзац заголовка с обычным нумерованным абзацем.
В общем, пробуйте, успеха вам. ))

Спасибо большое. Уже сам нашёл такие "штукендры" как поля - так гораздо удобнее smile

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

15

Re: Окончить цикл макроса

Заказать и установить недорогие рольсистемы в Сальске
Двери в Сальске
Балконы в Сальске
заказать натяжной потолок в сальске, недорогой натяжной потолок в Сальске, купить натяжной потолок в Сальске

16

Re: Окончить цикл макроса

заказать натяжной потолок в сальске, недорогой натяжной потолок в Сальске, купить натяжной потолок в Сальске
заказать рольсистемы в сальске, недорогие рольсистемы в Сальске, рольсистемы на заказ в Сальске
Заказать и установить недорогой натяжной потолок в Сальске
Рулонные шторы в Сальске