1

Тема: Умное удаление Шрифт - Цвет выделения текста - Жёлтый

Всем здравствуйте.

В есит нашел макрос

Sub Процедура1()
With ActiveDocument.Content.Find
    .Highlight = True
    .Format = True
    Do While .Execute = True
        If .Parent.HighlightColorIndex = wdRed Then
            .Parent.Delete
        End If
    Loop
End With
End Sub

Есть оригинальный файл 1.doc - внутри файла 2019-05-19_15-46-51.zip

Если из файла 1.doc я вручную удаляю строки, выделенные желтым - у меня на выходе файл 1_вручную.doc

Если к файлу 1.doc применить этот макрос тынц - у меня на выходе файл 1_macros.doc

Пожалуйста, я очень прошу, помогите, как сделать, чтобы макрос работал также, чтобы после макроса было также, как в файле 1_вручную.doc, чтобы макрос удалял строки, выделенные жёлтым без удаления в конце строки

2

Re: Умное удаление Шрифт - Цвет выделения текста - Жёлтый

Почему-то файл 2019-05-19_15-46-51.zip не прикрепился, файл 2019-05-19_15-46-51.zip здесь
внешняя ссылка

3

Re: Умное удаление Шрифт - Цвет выделения текста - Жёлтый

SharkyEXE пишет:

Почему-то файл 2019-05-19_15-46-51.zip не прикрепился, файл 2019-05-19_15-46-51.zip здесь
внешняя ссылка

Замените wdRed на wdYellow

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

4

Re: Умное удаление Шрифт - Цвет выделения текста - Жёлтый

Fck_This пишет:
SharkyEXE пишет:

Почему-то файл 2019-05-19_15-46-51.zip не прикрепился, файл 2019-05-19_15-46-51.zip здесь
внешняя ссылка

Замените wdRed на wdYellow

Понял вашу проблему. Поменяйте код процедуры на следующий:

Sub Процедура1()
With ActiveDocument.Content.Find
    .Text = Chr(13)
    .Highlight = True
    .Format = True
    Do While .Execute = True
        If .Parent.HighlightColorIndex = wdYellow Then
            .Parent.HighlightColorIndex = wdNoHighlight
        End If
    Loop
End With
With ActiveDocument.Content.Find
    .Highlight = True
    .Format = True
    Do While .Execute = True
        If .Parent.HighlightColorIndex = wdYellow Then
            .Parent.Delete
        End If
    Loop
End With
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871