エクセルVBA、フリーフォームで円を描画したい

質問

円の方程式 X = r * Sin(θ)、Y = r * Cos(θ)を使い、フリーフォームで円を描こうと思い、下記のマクロを書きました。
まず、最初からつまずきました。
マクロ名をSub Circleにしたらそれだけでエラー。
VBAにCircleという関数か何かあるのですか？

次に下記に名前を変えて実行したら、実行時エラー1004「アプリケーションまたはオブジェクトの定義エラー」だそうです。ためしにX0、Y0を100にしたらエラーは出ませんがスタートの座標100、100から円までの軌跡と円に接するところが変になります。
フリーフォームで真円を描くにはどこをどう直せばいいでしょうか？

Sub EN()
r = 50
π = Application.WorksheetFunction.Pi()
' X0 = 100
' Y0 = 100
X0 = r * Sin(0) + 100
Y0 = r * Cos(0) + 100
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, X0, Y0)
For θ = 0 To π * 2 Step π * 2 / 360
X = r * Sin(θ) + 100
Y = r * Cos(θ) + 100
.AddNodes msoSegmentCurve, msoEditingAuto, X, Y
DoEvents
Next
.ConvertToShape.Select'ここがエラー
End With
End Sub

回答No.5

imogasi · ベストアンサー

既にご指摘があるように、刻みを荒くすると旨く行くようです。
小生もいろいろ試してみました結果です。それもある時は
旨く行って、変えてないのに別の機会には旨く行かないこともあったようで、悩まされました。ご報告だけですみません。
Sub EN()
Cells.Clear
Dim x As Double
Dim y As Double
Dim pai As Double
Worksheets("sheet1").DrawingObjects.Delete
j = 0
R = 100#
pai = Application.WorksheetFunction.Pi()
pai = 3.14159
'-------0
j = j + 1
x0 = R * Sin(0) + 200#
y0 = R * Cos(0) + 200#
Cells(j, "A") = x0
Cells(j, "B") = y0
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x0, y0)
'--------1-359
For θ = 5 To 359 Step 5
j = j + 1
x = R * Sin(θ * pai / 180) + 200#
Cells(j, "A") = x
y = R * Cos(θ * pai / 180) + 200#
Cells(j, "B") = y
.AddNodes msoSegmentCurve, msoEditingAuto, x, y
Next
'--------
.AddNodes msoSegmentCurve, msoEditingAuto, x0, y0
j = j + 1
Cells(j, "A") = x0
Cells(j, "B") = y0
.ConvertToShape.Select
End With
End Sub
でFor θ = 5 To 359 Step 5の５を４にするとエラーがでて、５にするとうまく行きます。
初期値５もX0,y0から離れるようにしないと行けない。
（θ = 0 to・・やθ = 1 toはX0,y0と接近してだめ。）
（１）Forは小数点つきの数を指定していても、整数値を取って飛ぶ。Stepの取る数も同じ。
（２）必ず最初の点に戻って閉曲線になるべきかどうか、最初の点に繰り返しAddnodesして良いかどうか不明。
フリーフォームを使われるぐらいだから、簡単な下記のやり方は既にご存知でしょうね。
Sub test04()
cLeft = 200
cTop = 100
cWidth = 100
cHeight = 100
ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _
Left:=cLeft, Top:=cTop, Width:=cWidth, Height:=cHeight).Select
End Sub

お礼

ありがとうございました。
勉強になりました。

msoShapeOvalはもちろん存じております。
今回、円をぐるっと書いてみたかったのでフリーフォームでやってみました。

回答No.4

noname#29107

＃２です。
＞修正のプロシージャーを実行しましたが、やはり同じ実
＞行時エラーとなりました。
私の環境（Excel2002）では、先の修正で動作したのですが、バージョンなどに影響を受けるかもしれません。
＃３の方の回答にあるように、節点が近すぎるとエラーになるようですので、
r = 50
をもう少し大きくするか、
　　For θ = π * 2 / 60 To π * 2 Step π * 2 / 60
の刻みを粗くする。たとえば、
　　For θ = π * 2 / 45 To π * 2 Step π * 2 / 45
位に変えてみてください。これでエラー発生するなら、順次数値を変えてみて、エラーが発生しない数値を探してみてください。

いずれにしても、半径と刻みを調整すれば、先の回答内容で動作すると思います。

お礼

ありがとうございます。
友人のエクセル２００３でやってもらったらうまく動くそうです。
わたしの２０００では駄目でした。

回答No.3

ogura_kei

#1の書き込みをした者です。実は回答して直ぐに回答内容の誤りに気付き「間違ってました」と再書き込みをしたつもりだったのですが、急ぎの用件があってあわてたのでどうやら回答の確認ボタンを押さずに席を外してしまったようです。失礼しました。

#2のrebellionさん、正確な回答をありがとうございました。

それで、一部判明したことがあるのでご報告します。

以下だけでエラーになります。
ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 100, 150)
.AddNodes msoSegmentCurve, msoEditingAuto, 100, 150

そして以下とするとエラーはなくなります。
.AddNodes msoSegmentCurve, msoEditingAuto, 100, 158

つまり、接近しているとまずいようです。そして、その線でネット情報を調べたら同じ問題についての記述を見つけたのでご報告します。

http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200311/03110065.txt

の一番最後の報告に「節点の距離が近すぎるとダメみたいです」と記載されています。

お礼

ありがとうございます。
節点の距離が近すぎるとダメなんですね。
これってバグですね。

回答No.2

noname#29107

＞マクロ名をSub Circleにしたらそれだけでエラー。
一般的な英単語は予約語に引っかかる可能性がありますので、putcircleとかのように辞書にない形で、定義するのが普通だと思います。

＞実行時エラー1004「アプリケーションまたはオブジェクトの
＞定義エラー」
BuildFreeformについては詳しくないので、真の原因はよくわかりませんが、ADDNODEをForループで0から始めると、BuildFreeformで指定した最初の節点になるのが、まずいのではないかと思います。また、ForループでのStepの刻みも小さすぎるのではないかと思います。

以上を踏まえて修正してみると、
Sub EN()
Dim X As Single, Y As Single
R = 50
π = Application.WorksheetFunction.Pi()
' X0 = 100
' Y0 = 100
X0 = R * Sin(0) + 100
Y0 = R * Cos(0) + 100
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, X0, Y0)
　　For θ = π * 2 / 60 To π * 2 Step π * 2 / 60
　　　　X = R * Sin(θ) + 100
　　　　Y = R * Cos(θ) + 100
　　　　.AddNodes msoSegmentCurve, msoEditingAuto, X, Y
　　　　DoEvents
　　Next
　　.ConvertToShape.Select
End With
End Sub
といった感じでしょうか？

あとθやπのような2バイト系の字は、変数に使用しない方が好ましいと思います。また、この場合DoEventsも不必要だと思います。

補足

さっそくありがとうございました。
修正のプロシージャーを実行しましたが、やはり同じ実行時エラーとなりました。
残念です。

回答No.1

ogura_kei

多分ですね、
Visual Basic editorの[ツール]-[参照設定]中の[ConvertToShape]に対応するライブラリファイルが選択されていないのではないかと思います。

試してみてください。

補足

ありがとうございました。
[ConvertToShape]に対応するライブラリファイルとはどれなのでしょうか？
現在参照にチェックが入っているのは
Visual Basic For Applications
Microsoft Excel 9.0 Object Library
OLE Automation
Microsoft Office 9.0 Object Library
Microsoft Forms 2.0 Object Library
です。