I wanted to duplicate my active page in quantity to the first page. I used the code but it brings error "Object does not support this property or method"
Sub DuplicateToFirstPage()Dim sr As ShapeRange, nc As Integer, pnext As Page, sduplicate As Shapenc = InputBox("enter required")For i = 1 To ncSet sr = ActivePage.Shapes.AllSet pnext = ActiveDocument.InsertPages(1, False, ActiveDocument.Pages(1))For Each s In sr.ReverseRangeSet sduplicate = s.Duplicatesduplicate.MoveToLayer pnext.Layers(s.Layer.Name)Next sNext ipnext.Activate
End Sub
Is error appears on this line - sduplicate.MoveToLayer pnext.Layers(s.Layer.Name) ?
btw, ShapeRange have methods .Duplicate and .MoveToLayer, no need to do a For-Each loop
this line is the problem
Set pnext = ActiveDocument.InsertPages(1, False, ActiveDocument.Pages(1))
especially the bolded one
3rd parameter in InsertPages must be Long type. And ActiveDocument.Pages(1) returns Page.
Try this:
Set pnext = ActiveDocument.InsertPages(1, False, ActiveDocument.Pages(1).Index)
great!
this line of code you earlier gave me, I just discovered that it goes to the second page and not the first page
2nd parameter means before or after selected page
good
I tried to duplicate from a particular page (p) to another page (k) but gives me error (type mismatch) in the bold line
Sub DuplicatePage()Dim sr As ShapeRange, nc As Integer, pnext As Page, sduplicate As Shapenc = InputBox("enter required no.")p = InputBox("enter page from")k = InputBox("enter page to")For i = 1 To ncSet sr = ActiveDocument.Pages(p).Shapes.AllSet pnext = ActiveDocument.InsertPages(1, False, ActiveDocument.Pages(k).Index)For Each s In sr.ReverseRangeSet sduplicate = sr.Duplicatesduplicate.MoveToLayer pnext.Layers(s.Layer.Name)Next sNext ipnext.Activate
sduplicate is shape, sr.Duplicate returns shaperange
yea, you're right. Thanks
this also gives me problem.
Sub DuplicateSelection()Dim sr As Shape, nc As Integer, pnext As Page, sduplicate As Shape
For i = 1 To 1Set sr = ActiveSelectionSet pnext = ActiveDocument.InsertPages(1, False, ActivePage.Index)
Set sduplicate = sr.Duplicatesduplicate.MoveToLayer pnext.ActiveLayer
Next ipnext.Activate
I want to duplicate an active selection. the bold line is giving me problem
ActiveShape returns shape, ActiveSelectionRange returns some selected shapes as shaperange.
ok.
but increasing the quantity to 3 brings "type mismatch" error on the bold line
Sub DuplicateSelection()Dim sr As Shape, pnext As Page, sduplicate As Shape
For i = 1 To 3Set sr = ActiveShapeSet pnext = ActiveDocument.InsertPages(1, False, ActivePage.Index)
you again confuse shape and shaperange
Dim sr As ShapeRange, pnext As Page
Set sr = ActiveSelectionRange 'before loop
For i = 1 to 3
Set pnext = ActiveDocument.InsertPages(1, False, ActivePage.Index)
sr.Duplicate.MoveToLayer pnext.ActiveLayer
Next
ok. the problem is this line. I should have placed it before the loop. thanks
shark_ said:Set sr = ActiveSelectionRange 'before loop
Another challenge is that, if there are no shapes in page "p" it should display the message box but it still went ahead to duplicate empty page
If ActiveDocument.Pages(p).Shapes.Count = 0 ThenMsgBox "No objects found on the selected page to duplicate"End If
Place Exit Sub after MsgBox
you mean like this?
If ActiveDocument.Pages(p).Shapes.Count = 0 ThenMsgBox "No objects found on the selected page to duplicate": Exit SubEnd If
yes. To halt execution of your sub
I've done it. It stopped the sub whether there is a shape or not
yinkajewole said:It stopped the sub whether there is a shape or not
You having check whether exist shapes on the page or not
If ActiveDocument.Pages(p).Shapes.Count = 0 Then
MsgBox "No objects found on the selected page to duplicate"
Exit Sub
else
MsgBox "Work on"
End If
It still duplicated an empty page
yes
may be that page is not have any shapes?
I eventually got where i went wrong. I had to put these two lines code together. actually, there were some code in between.
P = TextBox12.ValueIf ActiveDocument.Pages(P).Shapes.Count = 0 Then MsgBox "No objects found on the specified page to duplicate": Exit Sub
Thanks.