[VBA] 円(楕円)を作ってジグザグに動かします

 Hi! KOBATO です! お久しぶりです!
 昨日の朝、姉が北海道に帰りました。なんだか変な新キャラとか増えちゃったけど、とりあえず日常が戻ってきました。詳しくは『こばとの英語ノート』 を読んでね。

 さて今日は 円をジグザグにアニメーションさせちゃおう という記事です。
 いわゆる有名なランダムウォークのアルゴリズムを使います。ランダムウォークのマクロはこばとの知り合いの BlogCat さんの数学教室にもありますけど、こばとに言わせると、あんなの全然ダメね~。やっぱ実際に動かさないとランダムウォークしてる実感わかないのね~。皆さんも BlogCat さんみたいにしょ~もないコードを書いたりしないように、KOBATO のサイトでしっかり勉強してくださいな~。
 

ワークシートに円を作成します

 てなわけで、まず最初はシートに円を作って名前をつけるマクロです。

 '円の作成

 Sub MakeCircle()

 Dim p1 As Single, p2 As Single
 Dim s1 As Single, s2 As Single

 With Selection
  p1 = 200  '左端からの位置
  p2 = 200  '上端からの位置
  s1 = 20   '図形の横幅
  s2 = 20   '図形の縦幅
 End With

 '円(楕円)を追加します
 ActiveSheet.Shapes.AddShape(msoShapeOval, p1, p2, s1, s2).Name = "circle"

 With ActiveSheet.Shapes("circle")

  '図形の背景色を青にします
  .Fill.ForeColor.RGB = vbBlue

  '図形の枠線を無しに設定します
  .Line.Visible = False

 End With

 End Sub

 実行するとシートに青い円がひょっこり出現します。
 AddShape メソッドの引数を msoShapeOval で指定して Shape コレクションに新しい図形(楕円)を追加しています。msoShapeOval は一般に楕円を作成しますが、縦幅と横幅を同じにすることで円になります。このマクロで図形に "circle" という名前をつけていますが、このオブジェクト名は次のマクロで使用します。
 

円をジグザグに移動させましょう

 上のマクロを実行してから(シートに円を作ってから)、次のマクロを実行すると、円がジグザグ(ランダム)にあちこち動き回りますよ。

 '円の移動

 Sub MoveCircle()

 Dim ct As Integer
 Dim crc As Object

 'オブジェクト変数に図形を入れます
 Set crc = ActiveSheet.Shapes("circle")

 Randomize

 For ct = 1 To 100

 '1 ~ 4 の乱数を発生させます
 rd = Int(RND * 4 + 1)

 '得られた乱数によって移動方向を決定します
 Select Case rd

 Case 1

  crc.Top = crc.Top + 3

 Case 2

  crc.Top = crc.Top - 3

 Case 3

  crc.Left = crc.Left + 3

 Case Else

  crc.Left = crc.Left - 3

 End Select

 '処理間隔を 0.1 秒に設定します
 Application.Wait [Now() + "0:00:00.1"]

 Next ct

 End Sub

 面白いから試してみてね~。

 Excel VBA オートシェイプで作った円をジグザグに動かす

 Wait メソッドは処理を指定時間だけ停止させます。

Application.Wait [Now() + "0:00:00.1"]

という記述で繰り返し処理の 1 ステップごとに 0.1 秒だけ時間を止めて円の移動速度を緩めています。この記述がないと、あっという間に処理が終わってしまい、円が瞬間移動したようにしか見えません。

 ≫ VBA 辞典メニューに戻って他の記事も読んでね~♪

スポンサードリンク
末尾大型広告
末尾大型広告

コメントをどうぞ

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください