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

  • 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.

  • 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