CorelDRAW X6 VBA Duplicating Page?

VBA Duplicating Page?

Here is my VBA Code to duplicate the page. Page is duplicated and all layers and shapes are also duplicated. but my problem is order of layer is revered in page back layers comes in front.

I Need help in this.

How to duplicate the page and layers with the same order?

Thanks in Advance.

Private Sub DuplicatePage()
    Dim sr As ShapeRange
    Dim s As Shape
    Dim p As Page

    Dim srToSelect As ShapeRange
    Set srToSelect = ActivePage.Shapes.All
    srToSelect.RemoveRange ActiveDocument.MasterPage.Shapes.All 'ActiveDocument.Pages(0).Shapes.All
    srToSelect.CreateSelection

Set sr = ActiveSelectionRange
Set p = ActiveDocument.InsertPages(1, False, ActivePage.Index)

    For Each s In sr
        s.Layer.Activate
        s.Duplicate
        s.MoveToLayer ActiveDocument.Pages(ActivePage.Index + 1).ActiveLayer
    Next s
    ActiveDocument.Pages(ActivePage.Index + 1).Activate
End Sub

Top Replies

Shelby Moore over 9 years ago +1

Here is one way to do this: Sub DupPage() Dim sr As ShapeRange Dim pNext As Page Dim sDuplicate As Shape Set sr = ActivePage.Shapes.All Set pNext = ActiveDocument.InsertPages(1, False...

0 harryLondon over 9 years ago

I think you can probably do that, by running that For loop backwards ...

For i = sr.Shapes.Count To 1 Step -1
        Set s = sr.Shapes(i)
        s.Layer.Activate
        s.Duplicate
        s.MoveToLayer ActiveDocument.Pages(ActivePage.Index + 1).ActiveLayer
Next i

This should get the shape order correct, but I'm not sure if it will preserve the actual layers -- I would expect to see the code based on layers rather than shapes.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 M.Murali over 9 years ago in reply to harryLondon

hi harry, its working fine. Thanks lot.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 notas over 9 years ago in reply to M.Murali

Hallo,

another way, right mousclick of the pagenumber-->duplicate the page-->with layer
Cancel
Up 0 Down

Reply

Verify Answer

Cancel

0 Shelby Moore over 9 years ago

Here is one way to do this:

Sub DupPage()
    Dim sr As ShapeRange
    Dim pNext As Page
    Dim sDuplicate As Shape
    
    Set sr = ActivePage.Shapes.All
    Set pNext = ActiveDocument.InsertPages(1, False, ActivePage.Index)
    
    For Each s In sr.ReverseRange
        Set sDuplicate = s.Duplicate
        sDuplicate.MoveToLayer pNext.Layers(s.Layer.Name)
    Next s
    
    pNext.Activate
End Sub

Notice the use of ReverseRange to Reverse the Range for you. :-)

-Shelby