1 Тема от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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

Только начал знакомство с макросами. Пользую "Запись", а потом леплю чего-нить. Необходим макрос, который ищет параметры заголовка (в тексте это обычно "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 Ответ от Alex_Gur

  • Окончить цикл макроса
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

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 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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
'----------------------------------------------------------------------

Сайтyshindin

4 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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
'----------------------------------------------------------------------

Сайтyshindin

5 Ответ от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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 Ответ от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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 Ответ от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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

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

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

8 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

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

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

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

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

Сайтyshindin

9 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

Fck_This пишет:

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

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

Сайтyshindin

10 Ответ от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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

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

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

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

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

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

11 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

Fck_This пишет:

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

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

Сайтyshindin

12 Ответ от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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

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

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

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

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

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

13 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171
  • За сообщение: 1

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

Fck_This пишет:

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

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

Сайтyshindin

14 Ответ от Fck_This

  • Окончить цикл макроса
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

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