OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Feature requests/wishlist

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 24-06-2010, 13:02
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default Duplicate into all pages

Hi, I'd like to duplicate and put duplicate in all pages in same position. I have a macro that duplicates only one time on the next page, I just need it to continue duplicating all the way to the end of the number of pages. Thanks for your time.

-Greg (might be able to figure this out...just asking for now)
Reply With Quote
  #2  
Old 24-06-2010, 13:54
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
You need to loop through pages.
Use the same loop that you have in the delete from selected area macro.
Try it and see if you can get it.

If not post some code and we'll help out.
-John
Reply With Quote
  #3  
Old 24-06-2010, 14:12
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

Yes, that's what I'm trying to use to carry out the function throughout all pages but instead of delete, duplicate a selected object. Here is the duplicate on next page code (by OS).

Code:
Sub dupOnNextPage()
                           Dim sr As ShapeRange, p As Page, cnt&, i&, shs As shapes
                           On Error Resume Next
                           If ActivePage Is Nothing Then Exit Sub
                           Set sr = ActiveSelectionRange
                           If sr.Count = 0 Then Set sr = ActiveLayer.Page.shapes.All.ReverseRange
                           If sr.Count = 0 Then Exit Sub
                           Set p = ActiveLayer.Page
                           
                           boostStart "dupOnNextPage " & (p.Index And &HFFFF) & " -> " & (p.Index + 1 And &HFFFF)
                           'If p.Next Is Nothing Then ActiveDocument.InsertPages 1, False, p.Index
                           sr.CopyToLayer p.Next.ActiveLayer
                           'boostFinish True, False
                           
                           p.Next.Activate
                           Set shs = p.Next.ActiveLayer.shapes: cnt = sr.Count: sr.RemoveAll
                           For i = 1 To cnt: sr.Add shs(i): Next
                           sr.CreateSelection
                           
                            For Each p In ActiveDocument.Pages
                                p.Activate
                            Next p
                           
                           UIrefresh
                           End Sub
I added the 'For Each p' to go to the next page but all of this is not arranged properly to get what I need.
Reply With Quote
  #4  
Old 24-06-2010, 15:40
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

Mr. John. Here is your code for deleting all objects in selected area thru all pages.
Code:
Public Sub DeletObjArea()

Dim p As Page
Dim s As Shape, sr As ShapeRange, sel As Shape, rect As Shape
Dim answ As Integer, answ1 As Integer
Dim x As Double, y As Double
Dim i As Integer, b As Boolean, shift As Long
ReDim xA(0) As Double
ReDim yA(0) As Double

'MsgBox "2 clicks. click the top left corner and then the bottom right corner of the marquee area in which you want shapes deleted." & vbNewLine & "Continue?", vbOKCancel
'If answ1 = 2 Then Exit Sub
ActiveDocument.BeginCommandGroup
EventsEnabled = False

i = 0
b = False
For i = 0 To 1
     b = ActiveDocument.GetUserClick(x, y, shift, 10, False, cdrCursorPickOvertarget)
       If Not b Then
           xA(i) = x: yA(i) = y
           ReDim Preserve xA(i + 1): ReDim Preserve yA(i + 1)
       End If
Next i

Set rect = ActiveLayer.CreateRectangle(xA(0), yA(0), xA(1), yA(1))
rect.Outline.Color = CreateCMYKColor(0, 100, 100, 0)
rect.Outline.Width = 0.01
rect.Outline.SetProperties Style:=OutlineStyles(2)
answ = MsgBox("Delete all objects within this rectangle, on all pages?", vbOKCancel)
If answ = 2 Then rect.Delete: Exit Sub


For Each p In ActiveDocument.Pages
    p.Activate
    Set sel = ActivePage.SelectShapesFromRectangle(xA(0), yA(0), xA(1), yA(1), True)
    If sel.Shapes.Count > 0 Then
        sel.Delete
    End If
Next p

EventsEnabled = True
ActiveDocument.EndCommandGroup
End Sub
Reply With Quote
  #5  
Old 24-06-2010, 16:10
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

HI.
Maybe copy and paste for this one.
Try this. I think this is what you was going for.

-John

Code:
Option Explicit
Sub copyOver()

Dim s As Shape, p As Page, i As Integer, cur As Integer
If ActiveSelection.Shapes.Count < 1 Then Exit Sub
Set s = ActiveSelection
s.Copy
Set p = ActivePage
cur = p.Index
For i = 1 To ActiveDocument.Pages.Count
    If i <> cur Then ActiveDocument.Pages(i).ActiveLayer.Paste
Next i
End Sub
Reply With Quote
  #6  
Old 24-06-2010, 16:41
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

Reply With Quote
  #7  
Old 24-06-2010, 16:42
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Copy and Paste

Copy and Paste is really slow. Take a look at this thread it gives you a pretty good idea how to do this:

Copy Selected Objects to other pages maintaining layers

Best of luck,

-Shelby
Reply With Quote
  #8  
Old 24-06-2010, 17:07
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default duplicate across pages

Hi.
Ok.
Here's a second try.

Code:
Sub copyOver2()

Dim p As Page, i As Integer, cur As Integer
Dim sDup As Shape, s As Shape
If ActiveSelection.Shapes.Count < 2 Then Exit Sub
Set s = ActiveSelection
Set sDup = s.Duplicate
cur = ActivePage.Index
For i = 1 To ActiveDocument.Pages.Count
    If cur <> i Then sDup.CopyToLayer ActiveDocument.Pages(i).ActiveLayer
Next i
ActiveDocument.Pages(cur).Activate
sDup.Delete

End Sub
-John
Reply With Quote
  #9  
Old 24-06-2010, 21:24
gorgo gorgo is offline
Senior Member
 
Join Date: Feb 2010
Posts: 169
Default

Quote:
Originally Posted by runflacruiser View Post
Hi.
Ok.
Here's a second try.

Code:
Sub copyOver2()

Dim p As Page, i As Integer, cur As Integer
Dim sDup As Shape, s As Shape
If ActiveSelection.Shapes.Count < 2 Then Exit Sub
Set s = ActiveSelection
Set sDup = s.Duplicate
cur = ActivePage.Index
For i = 1 To ActiveDocument.Pages.Count
    If cur <> i Then sDup.CopyToLayer ActiveDocument.Pages(i).ActiveLayer
Next i
ActiveDocument.Pages(cur).Activate
sDup.Delete

End Sub
-John
Works! Had to change line 5 from 2 to 1 since I will only be selecting one object to be duplicated thru the pages.
Reply With Quote
  #10  
Old 24-06-2010, 21:42
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default Super!

HI.
Glad to hear it.
-John

Edit: What kind of speed increase did you notice?

Last edited by runflacruiser; 24-06-2010 at 21:58. Reason: question...
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Selecting duplicate objects hywelgharris CorelDRAW/Corel DESIGNER VBA 12 21-05-2010 19:18
duplicate text? masterchiefph CorelDRAW/Corel DESIGNER VBA 9 15-11-2007 20:12
Problem with positioning a duplicate knowbodynow CorelDRAW/Corel DESIGNER VBA 3 05-05-2007 09:09
function delete after duplicate dominiqueL CorelDRAW/Corel DESIGNER VBA 2 18-10-2003 00:35
Probléme clones or duplicate dominiqueL CorelDRAW/Corel DESIGNER VBA 1 03-03-2003 09:17


All times are GMT -5. The time now is 05:44.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com