Chris,
It's best if you also post the actual code here. It's easier for people to comment on the code they can see rather than having to download something...
Anyway, for the rest of folks, here is the code.
start module:
Code:
Sub copytonext()
If ActiveDocument Is Nothing Then
MsgBox "Cannot Run Macro - No open Document", vbCritical
Exit Sub
End If
'test to see if any objects selected
If Not ActiveSelection.Shapes.count > 0 Then
response = MsgBox("Select All Objects Not On Master layers?", vbYesNo, "No Objects selected!")
If response = vbYes Then
Dim srToSelect As ShapeRange
Set srToSelect = ActivePage.Shapes.All
srToSelect.RemoveRange ActiveDocument.Pages(0).Shapes.All
srToSelect.CreateSelection
frmcopytonext.Show vbModal
ElseIf response = vbNo Then
Exit Sub
End If
End If
'test to see if all objects on master pages
Dim sr As ShapeRange
Dim s As Shape
Dim mcount As Integer
Set sr = ActiveSelectionRange
mcount = 0
For Each s In sr
If s.Layer.Master Then mcount = mcount + 1
Next s
If ActiveSelection.Shapes.count = mcount Then
MsgBox "Check Selection - cannot process objects on masterpages, quitting"
Exit Sub
End If
frmcopytonext.Show vbModal
End Sub
frmaskpage form:
Code:
Public pn As String
Private Sub Cmd_OK_Click()
Dim sr As ShapeRange
Dim s As Shape
Dim p As Page
pn = Val(pagenumber)
'rough test to see if actual numerical value typed
If Not pn > 0 Then
MsgBox "Please Check Input!"
Unload Me
Exit Sub
End If
'tests to see if user entered number is higher than number of existing pages
If pn > ActiveDocument.Pages.count Then
MsgBox "Check Page Numbers - input too high!"
Unload Me
Exit Sub
End If
'inserts new page, copies objects to it and then moves it
If frmcopytonext.Optnewask = True Then 'tests user choice from first form
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).MoveTo (pn)
ActiveDocument.Pages(pn).Activate
Unload Me
Exit Sub
End If
'copies objects to desired page
If frmcopytonext.Optask = True Then ''tests user choice from first form
Set sr = ActiveSelectionRange
For Each s In sr
s.Layer.Activate
s.Duplicate
s.MoveToLayer ActiveDocument.Pages(pn).ActiveLayer
Next s
ActiveDocument.Pages(pn).Activate
Unload Me
End If
End Sub
frmcopytonext form:
Code:
Private Sub Cmd_OK_Click()
Dim sr As ShapeRange
Dim s As Shape
Dim p As Page
Dim L As Layer
Dim vNewName As String
Dim pn As String
If Optnew = True Then
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
Unload Me
Exit Sub
End If
'Inserts Page, copies objects to that page then moves that page to end of document
If Optlast = True Then
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
C = ActiveDocument.Pages.count
ActiveDocument.Pages(ActivePage.Index + 1).MoveTo (C)
ActiveDocument.Pages(C).Activate
Unload Me
Exit Sub
End If
'Inserts Page, copies objects to that page then moves that page to beginning of document
If Optfirst = True Then
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).MoveTo (1)
ActiveDocument.Pages(1).Activate
Unload Me
Exit Sub
End If
'Uses second form to get page number, inserts page, copies objects to that page then moves it to chosen location
If Optnewask = True Then
frmaskpage.Show vbModal
Unload Me
Exit Sub
End If
'tests to see if user is already on the last page
If Optnext = True Then
If ActivePage.Index = ActiveDocument.Pages.count Then
MsgBox "Last Page - Cannot copy to next page"
Unload Me
Exit Sub
End If
ActiveShape.Layer.Activate
Set sr = ActiveSelectionRange
For Each s In sr
s.Layer.Activate
s.Duplicate
s.MoveToLayer ActiveDocument.Pages(ActivePage.Index + 1).ActiveLayer
ActiveDocument.Pages(ActivePage.Index + 1).Activate
Unload Me
Exit Sub
Next s
End If
'Uses second form to get page number to copy objects to
If Optask = True Then
frmaskpage.Show vbModal
Unload Me
Exit Sub
End If
End Sub
Private Sub cmd_cancel_Click()
Unload Me
Exit Sub
End Sub