[CDR 2023] Замена цвета

[izrukvruki]

Прошу помочь, стандартным поиском очень долго, файлов очень много...

Нужно в файле на текущей странице, без контейнеров, но группы есть, найти заливку (0,100,100,0) и сделать ее черной (0.0.0.100), а желтую заливку(0,0,100,0) сделать без заливки и найти синюю обводку (100,0,0,0) и тоже ее черной сделать

Спасибо

 

[izrukvruki]

вот так не работает...

Sub zamena_color()

Dim sh As Shape

For Each sh In ActiveDocument.ActivePage.Shapes
    If sh.Outline.Color = CreateCMYKColor(100, 0, 0, 0) Then sh.Outline.Color = CreateCMYKColor(0, 0, 0, 100)
Next sh

End Sub

 

[_MBK_]

 

[DukereD]

Еще моим макросом можно. и в подгруппах сразу выделить нужный цвет.

 

[dastin]

Нужно в файле на текущей странице

всё это, и не только, можно сделать уже довольно мохнатым макросом
... с одной поправочкой - оберон - похоже - волею божией помре - вместе с форумом
может Lev - как один из авторов - что-нибудь добавит о доступности оберона?
кстати - community кореловский тоже стал тупить ...
потому - последнюю версию положу прямо сюда.
то что_MBK_ - кино запостил видел - но не у верен, что там последняя инкарнация
...
а ведь кто-то "Спасибо" говорил

... обновлено
архив с макросом перезалит (ошибочно был загружен не самый последний вариант)
сейчас верный

 

[_MBK_]

Лично мне лень по форуму искать было, я нагуглил ссылку на первое попавшее видео для наглядности

 

[zollinger]

вот так не работает...

Sub zamena_color()

Dim sh As Shape

For Each sh In ActiveDocument.ActivePage.Shapes
    If sh.Outline.Color = CreateCMYKColor(100, 0, 0, 0) Then sh.Outline.Color = CreateCMYKColor(0, 0, 0, 100)
Next sh

End Sub

В группах не меняет? Завтра до офиса доеду, если будет время и не забуду, скину свой макрос Замена цвета. Оченно простой

 

[izrukvruki]

В группах не меняет? Завтра до офиса доеду, если будет время и не забуду, скину свой макрос Замена цвета. Оченно простой

вообще не работает...

 

[izrukvruki]

всё это, и не только, можно сделать уже довольно мохнатым макросом
... с одной поправочкой - оберон - похоже - волею божией помре - вместе с форумом
может Lev - как один из авторов - что-нибудь добавит о доступности оберона?
кстати - community кореловский тоже стал тупить ...
потому - последнюю версию положу прямо сюда.
то что_MBK_ - кино запостил видел - но не у верен, что там последняя инкарнация
...
а ведь кто-то "Спасибо" говорил
Посмотреть вложение 162148

Может просто Россию отрубили?

 

[izrukvruki]

всё это, и не только, можно сделать уже довольно мохнатым макросом
... с одной поправочкой - оберон - похоже - волею божией помре - вместе с форумом
может Lev - как один из авторов - что-нибудь добавит о доступности оберона?
кстати - community кореловский тоже стал тупить ...
потому - последнюю версию положу прямо сюда.
то что_MBK_ - кино запостил видел - но не у верен, что там последняя инкарнация
...
а ведь кто-то "Спасибо" говорил
Посмотреть вложение 162148

Вопрос снимается, этим макросом буду пользоваться. Быстро, благодаря истории

 

[DukereD]

Вот скачивал некоторые

 

[dastin]

этим макросом буду пользоваться

а вот и обмишурился ... Дзюба, блин ... положил да не то ...
поправил - теперь в исходном посте действительно то
lf_ColorReplacer29.3.9.zip
перекачайте пожалуйста

 

[dastin]

Может просто Россию отрубили?

так ить - никак - ни сайт - ни форум - ни просто ни через впн ... и даже иностранные граждане вопиют ...

 

[zollinger]

вот так не работает...

Sub zamena_color()

Dim sh As Shape

For Each sh In ActiveDocument.ActivePage.Shapes
    If sh.Outline.Color = CreateCMYKColor(100, 0, 0, 0) Then sh.Outline.Color = CreateCMYKColor(0, 0, 0, 100)
Next sh

End Sub

Тут просто ошибочка маленькая была. Вот так нужно color.IsSame
Но в группы она не пойдет, надо же их явно перебирать. И проверки нужны на тип шейпа. Рекурсивно нужно вызывать с группами. Мне лень

Sub zamena_color()

Dim sh As Shape

For Each sh In ActiveDocument.ActivePage.Shapes
    'MsgBox (sh)
    If (sh.Outline.Color.IsSame(CreateCMYKColor(100, 0, 0, 0))) Then sh.Outline.Color = CreateCMYKColor(0, 0, 0, 100)
Next sh

End Sub