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).ActivateEnd 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).ActiveLayerNext 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.
hi harry, its working fine. Thanks lot.
Hallo,
another way, right mousclick of the pagenumber-->duplicate the page-->with layer
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