Hello, I am trying to write this macro to duplicate or make copies of a selected object on all the pages in the document. (CorelDraw X6)
This seemed simple so I attempted to write it with my limited vba knowledge. For some reason, it is just not working. It only creates the copy on the first page where the object is selected.
The interesting part is that if I run the code step by step (F5) it will do the copies with no problem. But if I play the macro normally it will not.
The documents I am using have over 100 pages, it is for laser engraving. Also if I create a new document and draw a simple shape and try the macro it will work, but once I open any other file with many shapes on it it will not work.
Any help here will be appreciated.
Thanks
Jose
Sub PasteSelectedShapeOnAllPages() 'Check if there is a selection If ActiveSelection.Shapes.Count > 0 Then ActiveSelection.Shapes(1).Copy ActiveSelection.Delete
' Loop through all pages and paste the shape on each page For Each Page In ActiveDocument.Pages Page.Activate ActiveLayer.Paste Next Page Else ' Inform the user if there is no selection "Please select a shape to paste.", vbExclamation End IfEnd Sub
[CgsAddInMacro] public void DuplicateSelectionAllPages() { ShapeRange sr = corelApp.ActiveSelectionRange; corelApp.ActiveDocument.InsertPages(100, false, 1); for (int i = 2; i <= corelApp.ActiveDocument.Pages.Count; i++) { sr.Duplicate(); sr.MoveToLayer(corelApp.ActiveDocument.Pages[i].ActiveLayer); } }
Converted to VBA by chatGPT
Sub DuplicateSelectionAllPages() Dim sr As ShapeRange Set sr = ActiveSelectionRange
ActiveDocument.InsertPages 100, False, 1
Dim i As Integer For i = 2 To ActiveDocument.Pages.Count sr.Duplicate sr.MoveToLayer ActiveDocument.Pages(i).ActiveLayer Next iEnd Sub
Thank you!! It works! I appreciate your help.
Still would like to know what was wrong with my approach if possible, it seemed so simple, and still could not figure it out.
Thanks again!
Hello, Avoiding copy/paste is a good solution because they cause problems. JM1977's code works step-by-step with F8, or if Msgbox is turned on after For each...For Each page1 In ActiveDocument.Pages MsgBox "NOW I COPY ACTIVE SHAPE TO ALL PAGES OF DOCUMENT"ENTER will need to be pressed as many times as there are pages in the document.I don't know why, but if Msgbox is followed by Sendkeys "{ENTER}" then the process runs automatically after clicking the OK button on MsgBox. For Each page1 In ActiveDocument.Pages MsgBox "NOW I COPY ACTIVE SHAPE TO ALL PAGES OF DOCUMENT" 'paste on each page and if F8 step by step pressed SendKeys "{ENTER}"
Hello,Your code is all right, but not work wellA little changes make it workable.This is CorelDRAW problem, using Copy/Paste
Sub PasteSelectedShapeOnAllPages()Dim page1 As Page'Check if there is a selection If ActiveSelection.Shapes.Count > 0 Then ActiveSelection.Shapes(1).Copy 'BhBp ActiveSelection.Delete
' Loop through all pages and paste the shape on each page For Each page1 In ActiveDocument.Pages MsgBox "Press OK to continue" 'BhBp this row must exist to work SendKeys "{Enter}" 'BhBp this row must exist to work 'BhBp Page.Activate page1.Activate page1.ActiveLayer.Paste Next page1 Else ' Inform the user if there is no selection MsgBox "Please select a shape to paste.", vbExclamation End IfEnd Sub
Greetings!
Thanks so much. It works, that is a good workaround.