dポイントプレゼントキャンペーン実施中!

円の方程式 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

A 回答 (5件)

既にご指摘があるように、刻みを荒くすると旨く行くようです。


小生もいろいろ試してみました結果です。それもある時は
旨く行って、変えてないのに別の機会には旨く行かないこともあったようで、悩まされました。ご報告だけですみません。
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の5を4にするとエラーがでて、5にするとうまく行きます。
初期値5もX0,y0から離れるようにしないと行けない。
(θ = 0 to・・やθ = 1 toはX0,y0と接近してだめ。)
(1)Forは小数点つきの数を指定していても、整数値を取って飛ぶ。Stepの取る数も同じ。
(2)必ず最初の点に戻って閉曲線になるべきかどうか、最初の点に繰り返し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
    • good
    • 0
この回答へのお礼

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

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

お礼日時:2004/06/28 10:51

#2です。


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

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

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

お礼日時:2004/06/28 10:49

#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.cg …

の一番最後の報告に「節点の距離が近すぎるとダメみたいです」と記載されています。
    • good
    • 0
この回答へのお礼

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

お礼日時:2004/06/28 10:48

>マクロ名を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も不必要だと思います。

この回答への補足

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

補足日時:2004/06/25 18:49
    • good
    • 0

多分ですね、


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
です。

補足日時:2004/06/25 18:51
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!