ベストアンサー

エクセルVBAでオートシェープを円く動かしたい。

2004/06/22 15:35

星型をシート上で回転しながらぐるっと円周のように動かそうと、ためしに下記のマクロを書きましたが、やはり方向転換がぎこちなく、スムーズな丸い動きにはなりません。かと言って、上下左右以外に動かす方法はないでしょうし、何かいいやり方はないでしょうか？ Sub Star() With ActiveSheet.Shapes.AddShape(msoShape5pointStar, 273#, 43#, 50#, 50#) .Fill.ForeColor.SchemeColor = 13 .Line.Weight = 0.75 .Line.ForeColor.SchemeColor = 64 For i = 1 To 180 a = 1 b = 1 If i > 90 Then a = -1 If i < 45 Or i > 135 Then b = -1 .IncrementRotation 2 .IncrementTop 2 * a .IncrementLeft -2 * b DoEvents Next End With End Sub

AQUALINE
お礼率78% (144/184)

オフィス系ソフト
回答数3
ありがとう数3

みんなの回答 （3）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

noname#29107

2004/06/22 18:34 回答No.2

とりあえず＃１の方の参考URLは上の方だけ参考にされたらいかがですか。すなわち、 X = Rcosθ + X0 Y = Rsinθ + Y0 の部分です。参考URLでは実数計算の重さを嫌って、工夫されているのですが、それほど頻繁に使用するとも思えないので、このままの式を利用すればよいと思います。 Sub Star() With ActiveSheet.Shapes.AddShape(msoShape5pointStar, 200#, 344#, 50#, 50#) 　　.Fill.ForeColor.SchemeColor = 13 　　.Line.Weight = 0.75 　　.Line.ForeColor.SchemeColor = 64 　　wkr = 144 　　For i = 0 To 3.1415 * 2 Step 3.1415 * 2 / 60 　　　　a = Sin(i) * wkr + 200 　　　　b = Cos(i) * wkr + 200 　　　　.IncrementRotation 2 　　　　.Left = a 　　　　.Top = b 　　　　DoEvents 　　Next i End With End Sub 基本的に上記の数式を当てはめれば、こんな感じになると思います。

質問者

お礼 2004/06/23 09:24

ありがとうございます！おかげさまで円運動をする星型シェープが出来ました！VBAでサイン、コサインの計算が出来るとは思いませんでした。すごいですね。ただ、わからなかったのはFor i = 0 To 3.1415 * 2 Step 3.1415 * 2 / 60　の部分です。 0.10471666・・・刻みで60回まわしてるんですよね？これってどういう意味なんですか？よろしければお教え願えませんでしょうか？

質問者

補足 2004/06/24 20:18

X = Rcosθ + X0 Y = Rsinθ + Y0 の意味が良くわかってないので For i = 0 To 3.1415 * 2 Step 3.1415 * 2 / 60 もわからないのですね、きっと。数学のカテで再度質問をしてみます。ありがとうございました。

ログインすると、全ての回答が全文表示されます。

その他の回答 (2)

imogasi
ベストアンサー率27% (4737/17070)

2004/06/23 06:42 回答No.3

軌跡上の等速運動ではないのですが（Ｌｅｆｔ，Ｔｏｐを動かしているため）、時計と反対回りに６時から１２時回りに星が動きます。角度等速変化に変更すれば滑らかになるでしょう。取りあえず何かの参考になれば。 WaitSec 0.2　の数を少なくすると速く動きます。 Sub test01() Worksheets("sheet1").Select Worksheets("sheet1").Activate '--------- For i = 1 To 50 WaitSec 0.2 Worksheets("sheet1").DrawingObjects.Delete leftv = i + 100 topv = Sqr(2500 - i ^ 2) + 100 ActiveSheet.Shapes.AddShape(msoShape5pointStar, leftv, topv, 34.5, 34.5). _ Select DoEvents Next i '------- For i = 1 To 50 WaitSec 0.2 Worksheets("sheet1").DrawingObjects.Delete leftv = 150 - i topv = 100 - Sqr(2500 - (50 - i) ^ 2) ActiveSheet.Shapes.AddShape(msoShape5pointStar, leftv, topv, 34.5, 34.5). _ Select DoEvents Next i End Sub '--------- Sub WaitSec(sngWaitSec As Single) Dim sngCurTimer As Single sngCurTimer = Timer + sngWaitSec Do Loop Until Timer >= sngCurTimer End Sub

質問者

お礼 2004/06/23 11:30

ありがとうございます。難しくてわたしにはまだ理解できないところがたくさんありますが勉強させていただきます。

ログインすると、全ての回答が全文表示されます。

popesyu
ベストアンサー率36% (1782/4883)

2004/06/22 16:38 回答No.1

これは・・・直線でひし形を描くアルゴリズムではないかと。円弧と直線は全然違いますよ。小学生の頃の記憶を呼び覚ましましょうｗ実はそのものずばり円弧を描画するAPIなるものも存在するのですが、円を描くアルゴリズムはよく教科書などにも出て来る基本ですし、まぁ参考URLなどをじっくり読み込めば自作も出来るんじゃないでしょうか。