今回からは、”エクセル動くクリスマスカード”を作成してみましょう。
完成見本です。
今回紹介するのは、斜め移動、拡大、縮小、画面切り替えです。
まず、素材を集めましょう。素材は次の５点です。
１．もみの木 
２．サンタクロースX2（１個をコピー ）
３、そり
４．プレゼント（８個ぐらい）
５．雪景色 (適当な絵、または、写真を準備）画面いっぱいに挿入）
６．ワード
７．星（１０個ぐらい）
それでは、さっそく取り掛かりましょう。
１．２．３.４は、完成図とちがっていてもいいので、クリップアートなどから自分の気に入ったものを取り込みましょう。
今回は、インターネット上のフリー素材から取り込みました。
５の「雪景色」は、フリー素材屋HOSHINOさんのサイト
「http://www.s-hoshino.com/f_photo/fuyu.html」からいただきました。
６は、ワードアートで作成します。
[挿入]-[図]-[ワードアート]でサンプル文字（ここに文字を入力）のところに”Merry Christmas"と入れます。字の大きさはあとで調整しますから、フォント(Times New Roman)見本をみながら選んでください。 
７は、オートシェイプの星とリボンの星を使って１０個コピーします。
すべてが入ったら、それぞれに名前をつけましょう。
名前のつけ方は”エクセルアニメーション 第２回”を参照してください。
左向きの小さなサンタ（そりに乗せる）・・・サンタ１
上から降りてくるサンタ・・・サンタ２
右向きの小さなサンタ（帰りのそりに乗せる）・・・サンタ３
あとは、”そり”、”ワード”とします。（プレゼント、雪景色、もみノ木は変更しません）
星は、間違わないように、”星１”から”星１０”まで名前をつけましょう。
材料が揃ったら製作にとりかかりましょう。
まず、背景の”雪景色”をクリックして、周りにハンドル（白い丸）が付いたらドラッグして画面いっぱいに拡大します。（大きさは、パソコンの解像度などにより異なりますから調整してください。）
見本を参考にして
”もみノ木”の大きさを調整しておいて、画面の左位置に配置しましょう。
”そり”を画面右端に配置しましょう。
”サンタ”を小さくしてそりの座席に乗るように持ってきます。
”ワードアート”を小さくして、画面左上に配置します。
これからいよいよマクロの記録に入ります。
今回は、３個のオブジェクト（そり、サンタ、ワード）を移動させますので、途中でやり直ししないように注意しましょう。
失敗したら、全部削除してやり直しをしてください。修正するよりそのほうが早いでしょう。
第３回で作成した”マクロの記録”ボタンをクリックします。
まず、そりのクリップの周りに、ハンドル（白い小さな○）が付いていたときは、一度、ほかの場所をクリックしてハンドルをなくしておきます。
“そり“をクリックして数センチ左へ移動させます。
つぎに、“サンタ”をクリックして左上へ動かします。
つづいて、“ワード”をクリックして画面中央まで、右下方向へ移動させます。
さらに、“ワード”の大きさを、見本を参考にして拡大します。このさい、少しぐらい大きさが違っても問題ありません。
「記録終了」ボタンを押します。これで、マクロの記録は終了です。
出来上がったマクロは次のようなものです。数値が違っていても問題ありません。
Sub Macro1()
' Macro1 Macro
' マクロ記録日 : ユーザー名 :
' Keyboard Shortcut:
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.IncrementLeft -50.4
Selection.ShapeRange.IncrementTop -14.95
ActiveSheet.Shapes("サンタ").Select
Selection.ShapeRange.IncrementLeft -39.88
Selection.ShapeRange.IncrementTop -28.25
ActiveSheet.Shapes("ワード").Select
Selection.ShapeRange.IncrementLeft 39.88
Selection.ShapeRange.IncrementTop 28.25
Selection.ShapeRange.ScaleWidth1.85,msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight4.94,msoFalse,msoScaleFromTopLeft
End Sub
ここから説明をしていきます。
この部分は、“そり”を左に移動する部分です。
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.IncrementLeft -50.4・・・左へ
「Selection.ShapeRange.IncrementTop 14.95」（Top)がある場合は、その行は削除します。
これにより左へ移動します。
つぎの部分は、“ワード”（Merry Christmas）を右下へ移動します。
ActiveSheet.Shapes("ワード").Select
Selection.ShapeRange.IncrementLeft 39.88
Selection.ShapeRange.IncrementTop 28.25
つぎの部分は、“ワード”を拡大する部分です。
Selection.ShapeRange.ScaleWidth1.85,msoFalse, msoScaleFromTopLeft
数値（１.85）は倍率です。
この部分は“ワード”の高さを拡大します。
数値（4.94）は倍率です。
Selection.ShapeRange.ScaleHeight4.94,msoFalse,msoScaleFromTopLeft
ただし、今回は倍率は使わず、絶対数で拡大していきます。
それでは、完成コードは次のようになります。
前回までと同じく、できるだけコピーアンドペーストで修正を行いましょう。そのほうが、用語の打ち間違い（英文のつづりの間違い）などが起こらなくて便利です。 （名前に間違いがなければ、そのまま貼り付けても動きます）
数値は、画面を見ながら少しずつ変更して調整してください。
Sub 初期値()
'サンタ１（そりの上）
ActiveSheet.Shapes("サンタ１").Visible = True
ActiveSheet.Shapes("サンタ１").Select
Selection.ShapeRange.Left = 690
Selection.ShapeRange.Top = 325
Selection.ShapeRange.Width = 30
'サンタ２
ActiveSheet.Shapes("サンタ２").Visible = True
ActiveSheet.Shapes("サンタ２").Select
ActiveSheet.Shapes("サンタ2").Select
Selection.ShapeRange.Left = 50
Selection.ShapeRange.Top = 50
Selection.ShapeRange.Width = 50
Selection.ShapeRange.Visible = False
'サンタ３
ActiveSheet.Shapes("サンタ３").Visible = True
ActiveSheet.Shapes("サンタ３").Select
Selection.ShapeRange.Left = 125
Selection.ShapeRange.Top = 110
Selection.ShapeRange.Width = 50
Selection.ShapeRange.Visible = False
'メリークリスマス
ActiveSheet.Shapes("文字").Select
Selection.ShapeRange.Left = 50
Selection.ShapeRange.Top = 100
Selection.ShapeRange.Width = 10
'そり
ActiveSheet.Shapes("そり").Visible = True
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.Left = 550
Selection.ShapeRange.Top = 330
'プレゼント
For P = 1 To 8
ActiveSheet.Shapes("図" & P).Visible = False
Next
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
'そりの行進
Sub Parade()
'Macro
' マクロ記録日 : ユーザー名 :
'
' Keyboard Shortcut:
’音楽を入れる場合（今回は入れません）
'ミュージック
’ActiveSheet.Shapes("Object 69").Select
’Selection.Verb Verb:=xlPrimary
初期値 ’これはマクロ名ですですから、間違わないように。
'そりの行進
For n = 1 To 300 ’もみの木のそばまで
'そり
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.IncrementLeft -1
DoEvents
'サンタ
ActiveSheet.Shapes("サンタ１").Select
Selection.ShapeRange.IncrementLeft -1
DoEvents
Next
'サンタ上昇
ActiveSheet.Shapes("サンタ１").Select
For n = 1 To 60
Selection.ShapeRange.IncrementLeft -5
DoEvents
Mytimer (0.05)
Selection.ShapeRange.IncrementTop -4
Mytimer (0.05)
DoEvents
Next
'そり反転
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Left = 300
'サンタ切り替え
ActiveSheet.Shapes("サンタ１").Visible = False '小さいサンタを消す
ActiveSheet.Shapes("サンタ2").Visible = True '大きいサンタを出す
'Merry Christmasの縦横比を固定
ActiveSheet.Shapes("文字").Select
Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比固定
'Merry Christmasの文字をだんだん大きく
For n = 1 To 60
ActiveSheet.Shapes("文字").Select
Selection.ShapeRange.Height = n
Selection.ShapeRange.IncrementLeft 1
Selection.ShapeRange.IncrementTop 1.2
DoEvents
'サンタもいっしょに
ActiveSheet.Shapes("サンタ2").Select
Selection.ShapeRange.IncrementLeft 1
Selection.ShapeRange.IncrementTop 1.2
DoEvents
Next
'文字だけ右へ
For n = 1 To 70
ActiveSheet.Shapes("文字").Select
Selection.ShapeRange.IncrementLeft 3
DoEvents
Next
'サンタプレゼント配り
P = 2
ActiveSheet.Shapes("サンタ2").Select
ActiveSheet.Shapes("図1").Visible = True
r = 1: rr = 1
For n = 1 To 330
Selection.ShapeRange.IncrementLeft 1 * r
Selection.ShapeRange.IncrementTop 0.5
Selection.ShapeRange.IncrementRotation 10 * rr
rr = rr * -1
Mytimer (0.1)
On Error Resume Next
If n Mod 40 = 0 Then
ActiveSheet.Shapes("図" & P).Visible = True
P = P + 1
End If
'反転
If Selection.ShapeRange.Left > 250 Or Selection.ShapeRange.Left r = r * -1
End If
Next
'サンタ消滅
Selection.Visible = False
'--------------------------------------------------------------------
'帰り
'小さいサンタに変更
ActiveSheet.Shapes("サンタ３").Visible = True
'そりの帰り
For n = 1 To 350
'サンタ
ActiveSheet.Shapes("サンタ３").Select
Selection.ShapeRange.IncrementLeft 1
DoEvents
'そり
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.IncrementLeft 1
DoEvents
Next
ActiveSheet.Shapes("そり").Select
Selection.ShapeRange.Flip msoFlipHorizontal '反転
'ツリー点滅
Dim L As Integer
Dim S As Integer
On Error Resume Next 'エラー回避
Mylamp:
L = 1: S = 1
Do While True 'Loopまでを繰り返し
'空の星
ActiveSheet.Shapes("星" & S).Visible = False
DoEvents
Mytimer (0.2)
ActiveSheet.Shapes("星" & S).Visible = True
DoEvents
S = S + 1
If S > 10 Then S = 1
Mynext:
L = L + 1
If L > 11 Then GoTo Mylamp
rep = rep + 1
If rep > 50 Then
初期値
Range("a1").Select
Exit Sub
End If
Loop
End Sub
Sub 終了()
初期値
Range("a1").Select
End
End Sub
最後に、前回作成した ”Sub Mytimer”をコピーして貼り付けて置いてください。
Sub Mytimer(t)
mytime = Timer
Do Until Timer > mytime + t
DoEvents
Loop
End Sub
出来上がったら、”スタート”ボタンと”停止”ボタンをつけて動かしてみましょう。
うまく動きましたか？完成図のようにならない場合は、数値を変更して何回もテストをして決定してください。
手を掛けるほど、真心のこもったカードが出来上がりますよ。
では、今回はこれで終了です。
「Ｍｅｒｒｙ Ｃｈｒｉｓｔｍａｓ！」 Ｇｏｏｄ Ｌｕｃｋ！
