1 Тема от Aquinax

  • Aquinax
  • рядовой
  • Неактивен
  • Зарегистрирован: 02.04.2018
  • Сообщений: 4

Тема: Макрос не находит черную заливку

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

Sub FIND_AND_DEL_BLACK()    Selection.Find.ClearFormatting    With Selection.Find.ParagraphFormat        .Shading.BackgroundPatternColor = &HD05068    End With    With Selection.Find    .Wrap = wdFindContinue    End With    While Selection.Find.Execute = True    Selection.Find.Execute    Selection.Delete    WendEnd Sub

Он прекрасно справляется с удалением любых абзацев с окрашенной заливкой кроме того случая когда заливка черная. Любые формулировки черного цвета - 0, 000000, RGB(0,0,0), &H0 ... - приводят к тому, что макро удаляет абзацы белого цвета. Ниже приведен XML код примерного одного из абзацев, который мне необходимо удалить:<w:p w:rsidR=

2 Ответ от Aquinax

  • Aquinax
  • рядовой
  • Неактивен
  • Зарегистрирован: 02.04.2018
  • Сообщений: 4

Re: Макрос не находит черную заливку

[мой верхний пост был обрезан, возможно из-за того, что я не использовал code-тэги ... Полный текст моего поста ниже]
Здравствуйте,

я пытаюсь создать макрос, который бы находил и удалял текст с черной заливкой. Вот, что у меня пока получилось:

Sub FIND_AND_DEL_BLACK()

   Selection.Find.ClearFormatting
   With Selection.Find.ParagraphFormat
      .Shading.BackgroundPatternColor = &HD05068
   End With
   With Selection.Find
   .Wrap = wdFindContinue
   End With
   While Selection.Find.Execute = True
   Selection.Find.Execute
   Selection.Delete
   Wend

End Sub

Он прекрасно справляется с удалением любых абзацев с окрашенной заливкой кроме того случая когда заливка черная. Любые формулировки черного цвета - 0, 000000, RGB(0,0,0), &H0 ... - приводят к тому, что макро удаляет абзацы белого цвета.

Ниже приведен XML код примерного одного из абзацев, который мне необходимо удалить:

<w:p w:rsidR="00FE728A" w:rsidRPr="00FE728A" w:rsidRDefault="00FE728A" w:rsidP="00FE728A"><w:pPr><w:shd w:val="clear" w:color="auto" w:fill="000000"/><w:spacing w:after="0" w:line="570" w:lineRule="atLeast"/><w:rPr><w:rFonts w:ascii="scala-sans-sc-offc-pro--" w:eastAsia="Times New Roman" w:hAnsi="scala-sans-sc-offc-pro--" w:cs="Times New Roman"/><w:b/><w:bCs/><w:sz w:val="24"/><w:szCs w:val="24"/><w:lang w:val="en" w:eastAsia="en-GB"/></w:rPr></w:pPr><w:r w:rsidRPr="00FE728A"><w:rPr><w:rFonts w:ascii="scala-sans-sc-offc-pro--" w:eastAsia="Times New Roman" w:hAnsi="scala-sans-sc-offc-pro--" w:cs="Times New Roman"/><w:b/><w:bCs/><w:sz w:val="24"/><w:szCs w:val="24"/><w:lang w:val="en" w:eastAsia="en-GB"/></w:rPr><w:t xml:space="preserve">WORDS IN BLACK SHADING</w:t></w:r></w:p>

В экспертных статьях по теме, как например эта или эта, пишут, что полный цветовой HEX код - 32-битный, а значит 8-ми, а не 6-значный и его полное HEX и INT выражения другие и возможно по этой причине макро не распознает его. Если вы знаете, какое макро следует написать, чтобы находить и удалять вышеозначенные абзацы, поделитесь мыслями.

3 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

Я как-то баловался поиском текста с заливкой. И должен сказать, что ворду может быть абсолютно плевать на то, какой цвет у заливки.

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

4 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

Sub www()
Selection.HomeKey Unit:=wdStory
With Selection.Find
    .ClearFormatting
    .Highlight = True
        .Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        '.MatchWildcards = True
Do While .Execute = True
    MsgBox Selection.Range.Text
    'Selection.Collapse Direction:=wdCollapseEnd
    Selection.Range.Delete
Loop
End With
End Sub

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

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

5 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

Более того, если вам нужно удалять только чёрную заливку, то к Selection.Range.Delete добавляйте условие:
    

If Selection.Range.HighlightColorIndex = wdBlack Then
        Selection.Range.Delete
    End If
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

6 Ответ от Aquinax

  • Aquinax
  • рядовой
  • Неактивен
  • Зарегистрирован: 02.04.2018
  • Сообщений: 4

Re: Макрос не находит черную заливку

Уважаемый,

параметр Highlight относится к выделению текста (ab+кисточка), заливка (символ ведерко) маркирует на другом уровне и поэтому ваш макрос не работает. Спасибо за предложение тем не менее.

7 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

Оу, извините, уважаемый. Никогда не пользовался такой заливкой. Но у вас есть вариант перебор параграфов сделать.

Sub Макрос9()
'
Dim oDoc As Document
Set oDoc = ActiveDocument
Dim oPar As Paragraph
For Each oPar In oDoc.Paragraphs
    If oPar.Shading.BackgroundPatternColor = wdColorBlack Then MsgBox "wdBlack"
    If oPar.Shading.BackgroundPatternColor = -587137025 Then MsgBox "Чёрный -587137025"
    If oPar.Shading.BackgroundPatternColor = -654278401 Then MsgBox "красный? -654278401"
Next oPar
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

8 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

Аналогично через поиск и по заливке "ведёрком".

Sub www()
Selection.HomeKey Unit:=wdStory
With Selection.Find
    .ClearFormatting
    .ParagraphFormat.Shading.BackgroundPatternColor = -587137025
        .Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        '.MatchWildcards = True
Do While .Execute = True
    MsgBox Selection.Range.Text
    'Selection.Collapse Direction:=wdCollapseEnd
    Selection.Range.Delete
Loop
End With
End Sub

Если не знаете код заливки "ведёрком", то воспользуйтесь таким:

Sub Макрос9()
'
Dim oDoc As Document
Set oDoc = ActiveDocument
Dim oPar As Paragraph
For Each oPar In oDoc.Paragraphs
    If Not oPar.Shading.BackgroundPatternColor = wdColorAutomatic Then
        MsgBox oPar.Shading.BackgroundPatternColor
    End If
Next oPar
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

9 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

А вообще, по-хорошему, люди сбрасывают пример документа, чтобы было проще подсказать. Ковырять одну скопированную строку xml - такое. Если, конечно, вы хотите искать чёрную заливку непосредственно в document.xml файле - тогда другой вопрос уже, но и это, как мне кажется, элементарно - открыть его в блокноте, взять текст, найти в нём нужный параметр "w:fill" и заменить на требуемый.

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

10 Ответ от Aquinax

  • Aquinax
  • рядовой
  • Неактивен
  • Зарегистрирован: 02.04.2018
  • Сообщений: 4

Re: Макрос не находит черную заливку

Я не захотел писать ваш ник (из-за его характера), поэтому для замены назвал Вас уважаемым - у меня не было никакого желания поддеть.

11 Ответ от Fck_This

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

Re: Макрос не находит черную заливку

Aquinax пишет:

Я не захотел писать ваш ник (из-за его характера), поэтому для замены назвал Вас уважаемым - у меня не было никакого желания поддеть.

Лучше скажите, помогло или нет последнее.

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