今回は 図形を連続的に拡大・縮小させるアニメーションマクロ を作ってみます。
図形を連続的に拡大させたり縮小させる
まあ何はともあれ、次のマクロをコピーしてお持ち帰りくださいな。
Sub Change_Scale()
Dim x As Double, y As Double
Dim t As Double, wd As Double, ht As Double
Dim myrec As Shape
x = 50 '左端からの位置
y = 50 '上端からの位置
wd = 50 '図形の横幅
ht = 50 '図形の縦幅
'正方形を表示します
Set myrec = ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, wd, ht)
With myrec
'図形の背景色を緑にします
.Fill.ForeColor.RGB = vbGreen
'図形の枠線を消します
.Line.Visible = False
End With
'図形を拡大します
For t = 1 To 90
myrec.Width = myrec.Width + 1
myrec.Height = myrec.Height + 1
Application.Wait [Now() + "0:00:00.1"]
Next t
'図形を縮小します
For t = 1 To 90
myrec.Width = myrec.Width - 1
myrec.Height = myrec.Height - 1
Application.Wait [Now() + "0:00:00.1"]
Next t
End Sub
Change_Scale() を実行すると緑色の正方形が現れて、ゆっくり拡大したあとに、また縮小して元に戻ります。
今回のポイントとなるコードは以下の部分です。
For t = 1 To 90
myrec.Width = myrec.Width + 1
myrec.Height = myrec.Height + 1
Application.Wait [Now() + "0:00:00.1"]
Next t
Width プロパティはオブジェクトの幅を、Height プロパティはオブジェクトの高さを設定するので、これを少しずつ増やして、ゆっくりじっくり図形を大きくしているのです。縮小するときは －1 にすればいいのです。皆さんも色々な図形を大きくしたり小さくしてくださいな。それでは、また次回お会いしましょう。
