Thread: shaperange.add
View Single Post
  #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