View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Excel VBA drawing Arcs programmatically - not lining up!

I see what you mean. I suspect the reason relates to the precision of any
drawing is only to within (typically) 0.75 points. When the arc is redrawn
to accommodate the "adjustments" all sorts of rounding occurs, ending up
with the best fit and position of a rectangle that surrounds the arc.

With different sets of coordinates I found arcs might move pt in any
direction, not only to the right. The total 'error' may be compounded if
they move in different directions.

I don't see an easy solution. With some trig' though it should be possible
to predict what the outer rectangular sizes and positions will end up as,
rounded to the nearest 0.75. Then reposition the shapes where they ought to
be. Actually that should be doable - good luck!

Regards,
Peter T

"Pat Russell" wrote in message
...
Hi,

I'm trying to create a dial-type control for an Excel-based report. The
shape I'm after is basically the top half of a pie chart, and I'll add
numbers, needles etc.

I'm using msoShapeArc to create specific zones for the dial e.g.
green-amber-red, which will be a 0-100% scale. It's almost working, but

using
the .Adjustment(1) and (2) settings to set the angles is shifting the arcs
out of line, and I can't figure out why! The code is below - any help

greatly
appreciated.

To see the problem exaggerated, repeat the line ".Adjustments(1) = 144" in
the second segment and watch the arc shift right each time. For some

reason
it's not all of the arcs, just the some (the 2nd in this axample).

Thanks,

Pat.

Sub DrawDial()

Dim myArc As Shape

For Each myArc In ActiveSheet.Shapes
myArc.Delete
Next myArc

'draw first segment
Set myArc = ActiveSheet.Shapes.AddShape(msoShapeArc, 200, 100, 100, 100)
With myArc
.Adjustments(1) = 180
.Adjustments(2) = 144
.Fill.Visible = msoTrue
.Fill.Transparency = 0.3
.Fill.ForeColor.SchemeColor = 11
End With

'draw second segment
Set myArc = ActiveSheet.Shapes.AddShape(msoShapeArc, 200, 100, 100, 100)
With myArc
'THIS NEXT LNE SHIFTS THE ARC RIGHT BY 1 POINT!
.Adjustments(1) = 144
.Adjustments(2) = 70
.Fill.Visible = msoTrue
.Fill.Transparency = 0.3
.Fill.ForeColor.SchemeColor = 53
End With

'draw third segment
Set myArc = ActiveSheet.Shapes.AddShape(msoShapeArc, 200, 100, 100, 100)
With myArc
.Adjustments(1) = 70
.Adjustments(2) = 0
.Fill.Visible = msoTrue
.Fill.Transparency = 0.3
.Fill.ForeColor.SchemeColor = 10
End With

End Sub