OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

 
 
Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 27-06-2011, 01:50
HeauxmBru
Guest
 
Posts: n/a
Default shaperange.add

I am having trouble with the shaperange.add method. I am using it in a For statement with a shape.duplicate(...) method. For some reason I only have 1 shape in the range through the procedure. I've seen this same code in other procedures and it works fine. Just not in mine. I've tried several things but nothing works. I'm not sure what I'm missing.

Here is my code:
Code:
Sub CreateDuplicates()

    Const conX As Double = 0.25540157480315 '   x position of NSI Box
    Const conY As Double = 0.1685           '   y position of NSI Box
    Const conW As Double = 13.7275          '   w width of NSI Box
    Const conH As Double = 10.5449015748032 '   h height of NSI Box
    Const Margin As Double = 0.025            '   Page margin in inches
    Dim s1 As Shape, s2 As Shape
    Dim sr As New ShapeRange
    Dim i As Integer
    Dim x#, y#, w#, h#
    Dim x1#, y1#, w1#, h1#
    Dim xGutter As Double, yGutter As Double
    Dim RowNum As Long, ColNum As Long
    Dim sx As Double, sy As Double          '   new coords for first shape
    Dim d As Document
    
    Set d = ActiveDocument
    
    d.BeginCommandGroup "Create Duplicates"
    
    On Error GoTo ErrHandler
    
    Set s1 = ActiveSelection            '   target shape
    s1.GetBoundingBox x, y, w, h        '   target coords +
    w1 = w
    h1 = h
    
    RowNum = conW / (w + 1 + Margin)
    xGutter = (conW - (w * RowNum)) / (RowNum + 1)
    sx = xGutter + conX
    
    ColNum = conH / (h + 1 + Margin)
    yGutter = (conH - (h * ColNum)) / (ColNum + 1)
    sy = yGutter + conY

    d.DrawingOriginY = d.ActivePage.SizeHeight / 2

    s1.SetPosition sx, -sy
    sr.Add s1
    
    For i = 1 To RowNum - 1
        sr.Add s1.Duplicate(w + xGutter, 0)
'        Set s2 = s1.Duplicate
'        s2.Move w + xGutter, 0
'        s2.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
        s1.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
        w = w + w1 + xGutter
'        MsgBox sr.Count & " shapes", vbOKOnly
    Next i
    
    d.DrawingOriginY = -d.ActivePage.SizeHeight / 2
    
ExitSub:
    d.EndCommandGroup
    Exit Sub
ErrHandler:
    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
    
End Sub
I'd appreciate any suggestions.
Reply With Quote
 


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
Create multiple elements in shaperange(faster) isvaljek Macros/Add-ons 2 24-03-2009 13:06
Shaperange to Layer ebu CorelDRAW/Corel DESIGNER VBA 2 19-01-2008 04:44
Draw X3: VBA: rotate behaviour for shaperange changed wOxxOm CorelDRAW/Corel DESIGNER VBA 0 30-01-2006 12:08


All times are GMT -5. The time now is 12:35.


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