Creating this macro is driving me nuts!

I'm trying to write a macro and it's driving me nuts.

I have a specific shape that I need to place two dots or ellipses on at specific points. When I have my shape aligned to the bottom center of my page the macro works fine but if the shape is anywhere else and often this is the case, the dots won't place right.

I need two black dots both to be .125" x .125", filled black, no outline

dots are centered horizontally and placed vertically as shown. my code at the bottom

Sub SwiftCreekHoles()
Dim sr As ShapeRange, srGroup As New ShapeRange, srGroup2 As New ShapeRange
Dim x As Double, y As Double, w As Double, h As Double
Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub
ActiveDocument.BeginCommandGroup "SwiftCreekHoles"
sr.GetBoundingBox x, y, w, h

srGroup.Add ActiveLayer.CreateEllipse(x, y, 0.125, 0.125) 'top hole
srGroup.Move x + w / 2 - 0.0625, y + h - 3.0625
ActiveSelection.Fill.UniformColor.CMYKAssign 45, 45, 45, 100

srGroup2.Add ActiveLayer.CreateEllipse(x, y, 0.125, 0.125) 'bottom hole
srGroup2.Move w / 2 - 0.0625, 3.7875
ActiveSelection.Fill.UniformColor.CMYKAssign 45, 45, 45, 100
End Sub

Parents
No Data
Reply
  • Myron,

    I suspect that you want to use CreateEllipse2, not CreateEllipse.

    I'm sure this isn't the slickest, but I think it works:

    Sub foo()
        Dim sr As ShapeRange
        Dim s1 As Shape
        Dim s2 As Shape
        
        Set sr = ActiveSelectionRange
        If sr.Count = 0 Then Exit Sub
        
        For Each s1 In sr
            Set s2 = ActiveLayer.CreateEllipse2(s1.CenterX, s1.BottomY + 3.85, 0.125, 0.125)
            s2.Fill.UniformColor.CMYKAssign 45, 45, 45, 100
            Set s2 = ActiveLayer.CreateEllipse2(s1.CenterX, s1.BottomY + 9, 0.125, 0.125)
            s2.Fill.UniformColor.CMYKAssign 45, 45, 45, 100
        Next s1
    End Sub

Children