[CDR 2024] Помогите подправить макрос "Вставка лого"

NemoSUN

NemoSUN

Топикстартер
15 лет на форуме
Сообщения
240
Реакции
0
Макрос берёт копию выделенного и проставляет на всех открытых страницах. В X16 данный макрос работает без проблем. В 2024 макрос вставляет копию на правой стороне листа посередине. Если разблокировать слой вручную и вручную вставить копию, то всё нормально копируется и без вопросов. Если работает макрос, то Corel начинает вдобавок спрашивать про вставку и слежение за стилями.

Код: 
Sub CopyLogo()
Dim d As Document
Dim s As Shape
Dim Lg As Layer
Set s = ActiveShape

For Each d In Application.Documents
    For Each Lg In d.ActivePage.Layers
        If Lg.Name = "Logo" Then
            Lg.Activate
            d.ActiveLayer.Editable = True
            Lg.Delete
            d.ActivePage.CreateLayer ("Logo")
            d.ActiveLayer.Paste
            d.ActiveLayer.Editable = False
            d.Save
            d.ActivePage.Layers("General").Activate
        End If
    Next
Next

End Sub
 
Ваша ошибка в том, что вы создаете и удаляете слои, двигаясь в цикле по активным слоям. Это как тащить себя из болота за волосы или рубить сук, на которых сидишь.
 
_MBK_ сказал(а):
Ваша ошибка в том, что вы создаете и удаляете слои, двигаясь в цикле по активным слоям. Это как тащить себя из болота за волосы или рубить сук, на которых сидишь.
Нажмите, чтобы раскрыть...
Не спорю. Но в 16м то работает. Значит логика макроса работоспособна. Я так понимаю.
 
NemoSUN сказал(а):
Не спорю. Но в 16м то работает. Значит логика макроса работоспособна. Я так понимаю.
Нажмите, чтобы раскрыть...
Логика макроса шита на живую нитку, в 16 версии работает, скорее, вопреки, чем благодаря. Если честно, я даже не пойму что именно такое странное вы хотите реализовать этими удалениями-добавлениями слоев с копипастом в никуда? Это, часом, не очередная жертва вайбкодинга или просто нежизнеспособный гибрид нейросети и автозаписи?
 
_MBK_ сказал(а):
Логика макроса шита на живую нитку, в 16 версии работает, скорее, вопреки, чем благодаря. Если честно, я даже не пойму что именно такое странное вы хотите реализовать этими удалениями-добавлениями слоев с копипастом в никуда? Это, часом, не очередная жертва вайбкодинга или просто нежизнеспособный гибрид нейросети и автозаписи?
Нажмите, чтобы раскрыть...
Мне надо шапку страницы на слое Logo копировать на все остальные открытые страницы. Можно, конечно, вручную. Но у меня не 1 и не 2 страницы. Таким образом, я радектирую один раз шапку и размножаю её потом на пару сотен страниц. И чтобы не попортить впопыхах случайно слой, его надо бы блокировать после изменения.
 
NemoSUN сказал(а):
Lg.Delete
Нажмите, чтобы раскрыть...
А вот эта строка зачем? И зачем вы новый слой создаете да еще и в цикле перебора? Зачем документ в этом цикле сейвите? Я сильно удивлен что код рабочий хотя бы в 16 '8()'
 
  • Спасибо
Реакции: Yar, BSG_ganjawars, _MBK_ и ещё 2
NemoSUN сказал(а):
Потому что мне надо редактировать страницы, где уже был размещён заголовок. Я не создаю новые страницы.
Нажмите, чтобы раскрыть...
Может че не понял...

 
  • Спасибо
Реакции: zollinger и _MBK_
Ну хорошо, зачем вы вообще со слоями заморочились?
Ладно, я понимаю так, что процедура названа неправильно, она по смыслу "PasteLogo" так как перед ее работой лого уже в буфере. Но почему нельзя просто цикл по всем открытым документам сделать - activate/paste и все, зачем пляски с созданием-удалением слоев???
 
Он удаляет лого, если оно уже есть, и меняет на другое, поэтому. И чтобы потом можно было сделать то же самое, поэтому слои
 
zollinger сказал(а):
Он удаляет лого, если оно уже есть, и меняет на другое, поэтому
Нажмите, чтобы раскрыть...
Ну да, но делает он это только, если слой "Logo" уже есть. Причем, после добавления слоя "Logo" он продолжает искать слой "Logo", чтобы удалить слой "Logo", чтобы потом добавить слой "Logo", чтобы...
zollinger сказал(а):
И чтобы потом можно было сделать то же самое, поэтому слои
Нажмите, чтобы раскрыть...
Рекурсия божественна!
 
Так вы добавьте сразу еще и копирование в макрос, а не заранее копируйте. Запоминайте координаты копируемого объекта, после вклейки перемещайте объект по этим координатам, и всё. Если не хотите в текущий документ повторно вклеить (хотя вы же все равно создаете слой заново, поэтому пофиг), то запомните имя документа, и проверяйте его перед основным циклом работы. Если он - пропускайте
 
Последнее редактирование:
NemoSUN сказал(а):
В 2024 макрос вставляет копию на правой стороне листа посередине. Если разблокировать слой вручную и вручную вставить копию, то всё нормально копируется и без вопросов. Если работает макрос, то Corel начинает вдобавок спрашивать про вставку и слежение за стилями.
Нажмите, чтобы раскрыть...
Нормально работает в 2024

_MBK_ сказал(а):
Рекурсия божественна!
Нажмите, чтобы раскрыть...
добавить Exit For, чтобы цикл лишнего не крутился, хотя и без этого работает
Код: 
Sub CopyLogo()
    Dim d As Document
    Dim Lg As Layer
    For Each d In Application.Documents
        For Each Lg In d.ActivePage.Layers
            If Lg.Name = "Logo" Then
                Lg.Activate
                d.ActiveLayer.Editable = True
                Lg.Delete
                d.ActivePage.CreateLayer ("Logo")
                d.ActiveLayer.Paste
                d.ActiveLayer.Editable = False
                d.Save
                d.ActivePage.Layers("General").Activate
                Exit For
            End If
        Next
    Next
End Sub
 
Ну потому что, например, ТС не говорит, что работать оно у него должно только если слой Logo уже есть. Вообще, ТЗ сформулировано крайне талантливо
 
Chiga сказал(а):
Нормально работает в 2024
Посмотреть вложение 176220

добавить Exit For, чтобы цикл лишнего не крутился, хотя и без этого работает
Код: 
Sub CopyLogo()
    Dim d As Document
    Dim Lg As Layer
    For Each d In Application.Documents
        For Each Lg In d.ActivePage.Layers
            If Lg.Name = "Logo" Then
                Lg.Activate
                d.ActiveLayer.Editable = True
                Lg.Delete
                d.ActivePage.CreateLayer ("Logo")
                d.ActiveLayer.Paste
                d.ActiveLayer.Editable = False
                d.Save
                d.ActivePage.Layers("General").Activate
                Exit For
            End If
        Next
    Next
End Sub
Нажмите, чтобы раскрыть...
Не стоит поощрять говнокод, даже если он случайно работает правильно!
 
Для ответа нужно войти/зарегистрироваться
Верх Низ
Назад