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

質問

星型をシート上で回転しながらぐるっと円周のように動かそうと、ためしに下記のマクロを書きましたが、やはり方向転換がぎこちなく、スムーズな丸い動きにはなりません。
かと言って、上下左右以外に動かす方法はないでしょうし、何かいいやり方はないでしょうか？

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

回答No.2

noname#29107 · ベストアンサー

とりあえず＃１の方の参考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
基本的に上記の数式を当てはめれば、こんな感じになると思います。

お礼

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

補足

X = Rcosθ + X0
Y = Rsinθ + Y0
の意味が良くわかってないので
For i = 0 To 3.1415 * 2 Step 3.1415 * 2 / 60
もわからないのですね、きっと。

数学のカテで再度質問をしてみます。
ありがとうございました。

回答No.3

imogasi

軌跡上の等速運動ではないのですが（Ｌｅｆｔ，Ｔｏｐを動かしているため）、時計と反対回りに６時から１２時回りに星が動きます。
角度等速変化に変更すれば滑らかになるでしょう。
取りあえず何かの参考になれば。
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

お礼

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

回答No.1

popesyu

これは・・・直線でひし形を描くアルゴリズムではないかと。円弧と直線は全然違いますよ。小学生の頃の記憶を呼び覚ましましょうｗ

実はそのものずばり円弧を描画するAPIなるものも存在するのですが、円を描くアルゴリズムはよく教科書などにも出て来る基本ですし、まぁ参考URLなどをじっくり読み込めば自作も出来るんじゃないでしょうか。

参考URL：

http://www2.starcat.ne.jp/~fussy/algo/algo2-1.htm

お礼

> これは・・・直線でひし形を描くアルゴリズムではないかと。

おっしゃる通りです。軌跡を残すわけではないからこれでも円運動に見えないかなあと思ったのですが駄目でした。

参考URL拝見しましたが、からきし数学音痴のわたしには到底無理のようです。トホホ