円弧の描画について

エクセルのワークシート上に2点(x1,y1)、(x2,y2)の座標があり、半径がrと決まっている場合に、(x1,y1)を始点、(x2,y2)を終点とする半径rの円弧を描きたいのですが、VBAで教えていただけますでしょうか？

例えばエクセルのワークシート上に2点(600,400)と(500,300)という座標があります。この座標は、

Dim ShapeA As Shape, ShapeB As Shape

Set ShapeA = ActiveSheet.Shapes.AddShape _
(msoShapeOval, 600, 400, 2, 2)
Set ShapeB = ActiveSheet.Shapes.AddShape _
(msoShapeOval, 500, 300, 2, 2)

というコードでワークシート上に描いています。

この2点をそれぞれ始点、終点として、半径100の円弧を描く方法を考えているのですが、
VBA初心者の為、困っています。VBAで円弧を描く方法がありましたら是非教えていただきたく
お願い致します。

よろしくお願い致します。

No.1 回答者： akina_line 回答日時： 2008/10/28 09:05

こんにちは。

　描画オブジェクトのひとつに「曲線」がありますが、マウスでクリックした点をつないで曲線にするものです。
　円弧の通過点を計算して追加していけば円弧になると思います。オブジェクトの名前やメソッドはマクロのレコーディング機能で確認できます。

では。

この回答への補足

akina_line様
早々にご教授いただきありがとうございます。参考にさせていただきます。

質問の補足なのですが、エクセルのＡ列にＸ座標、Ｂ列にＹ座標が
1行～n行あらかじめ入力されており、エクセル上にそれぞれのＸＹ
座標を描画して、1行目のＸＹ座標と次の行の
ＸＹ座標を直線コネクタで結ぶという作業をn行まで行っています。
ところがたまにＣ列に半径Ｒが入る事があり、その場合は、
2点の座標を半径Ｒの円弧で結ぶ必要があります。
その為、2点を１つの円弧で出来れば結びたいと考えています。

ActiveSheet.Shapes.AddShape(msoShapeArc, X1, Y1, R R).Select
Selection.ShapeRange.Adjustments.Item(1) = 開始角
Selection.ShapeRange.Adjustments.Item(2) =終了角
みたいな形で描画出来ればと思うのですが、開始角と終了角を
求めるコードが、なかなか思い浮かびません。
素人でまだまだ勉強不足な為、稚拙な質問で大変申し訳ありませんが、
何卒ご教授いただきたくお願い致します。

補足日時：2008/10/29 09:45

この回答へのお礼

akina_line様
早々にご教授いただきありがとうございます。参考にさせていただきます。

お礼日時：2008/10/30 11:58

No.2 ベストアンサー 回答者： imogasi 回答日時： 2008/10/29 10:26

私なりにやってみて以下報告します。

ただし、私には判らない点は残ったままですが。
ーー
エクセルのオートシェイプで基本図形に円弧（Arc)があります。
Ｓｈｉｆｔキーを押しつつ書くと真円の１／４円弧がかかれるようです。
そこで右下の黄色い小○点を上に引き上げると、１／４円でなく円の一部になるようです。
マクロの記録をとると
Sub Macro1()
ActiveSheet.Shapes.AddShape(msoShapeArc, 200, 200, 300, 300).Select
Selection.ShapeRange.Adjustments.Item(2) = 54.9544
End Sub
などのようになります。
３００，３００はＨｅｉｇｈｔ、Ｗｉｄｔｈの値で、１／４円の場合は半径に当たるので、半径を指定すればよいと思う（＊１）。
「そこで黄色い小○点を上に引き上げる」操作が、Adjustments
にたると思います（＊２）
そして左上黄色小○点を動かすと
Selection.ShapeRange.Adjustments.Item(1) = 76.017
とＩｔｅｍ（１）になるところから、Ｉｔｅｍ（１）が左上黄色小○点、Ｉｔｅｍ（２）が右下黄色小○点を左右するものと思います（＊３）
この数値を決めると任意の円弧をワークシート上に描けると思われます。
（ただし、下手に図形のサイズを変えると、図形がゆがんで円弧でなくなります。黄色小○点を掴んで端点を動かすことです。）
ーー
＞、(x1,y1)を始点、(x2,y2)を終点とする場合どう計算するか
は勉強してみてください。
ーー
＊１－＊３が私には断言できるか１００％は自信の無いところです。
ーー
そして同じようなことを考えた
http://park7.wakwak.com/~efc21/cgi-bin/exqaloung …
がありました。
「Adjustments.Item VBA」でＷＥＢ照会すると、予想外の結構の数の記事があるようです。調べてみてください。
ーー
微少直線で円を書くこともやってみましたが、微少直線１つ１つが独立した線（オブジェクト）で、グループ化などがややこしくて、考えるのをやめました。
参考
円弧を描く
Sub test03()
Worksheets("sheet1").DrawingObjects.Delete
r = 300
mx = 100
l = 400
my = l - Sqr(r ^ 2 - mx ^ 2)
For x = 100 To 250 Step 1
y = l - Sqr(r ^ 2 - x ^ 2)
ActiveSheet.Shapes.AddLine mx, my, x, y
mx = x
my = y
Next
End Sub
ーー
何かの参考になれば。

この回答へのお礼

imogasi様
とても丁寧に教えていただきありがとうございます。
いろいろと調べて何とか希望通り円弧を描く事が出来ました。

お礼日時：2008/10/30 11:53