前回に続いて”くじらのデート”を完成させましょう。
今回追加するのはくじらの会話の部分です。
ただ、くじらが移動するだけでは面白くないので、その間に会話を交わすようにしてみました。会話の内容は自由に変えられるので、楽しいものを考えて作って見ましょう。
言葉の吹き出しはエクセルの図形描画から取り出して大きさ、形を整えます。
「オートシェイプー吹き出しー雲形吹き出し」
ことば２ ことば１
1個作ってそれをコピーします。さらに片方の吹き出しを反転させておきます。
[図形の調整]-[回転/反転]-[左右反転]
用意した吹き出しに名前をつけて配置します。（位置はコードのほうで決めますから適当な位置でいいです）
左に吹き出し口のあるほうを”ことば１”、右にあるほうを”ことば２”とします。
さいごに、タイトルとエンドマークを作成します。
「ワードアート」を使って”くじらのデート”と”おわり”を作ります。大きさなどは前回の見本を参考に適当に作りましょう。
さらにそれぞれに名前("くじらのデート"を「はじめ」、”おわり”を「おわり」）をつけておきます。
これも適当に配置しておきます。
はじめ
おわり
これで材料はそろいました。
それでは、これらのオブジェクトは移動しますので、最初に初期位置を設定しておきましょう。
前回の”初期位置”のつぎを下のように変更します。（青色・・・変更箇所 赤色・・・追加箇所）
ただし、使用するパソコンの画面サイズによって位置が変わりますから、各人で調整してください。
位置決めはこれまでの作品を参考にして、Left,Topで指定しましょう。
その際、オブジェクトの名称を間違わないように注意が必要です。
表示する言葉は、エクセルシートの適当な場所に書き込んでおきます。
上の例では、１４列の１行から１０行までに、会話を交互に記入しておきます。
内容は自由です。面白いものを考えて挿入してください。
今回は、同じコードを繰り返す場合に簡便化できるように、With ステートメントを使ってみましょう。
Withステートメントを使用すると、一度指定したオブジェクト名の再指定を省略することができます。
今回は、Left,Top,Visible だけですが、同じオブジェクトに対するオブジェクト名を省略することができるので効果的です。
文のはじめのピリオド「。」を忘れないように。
マクロの全体を表示しておきます。
今回は、ディスプレーによって位置異なるので調整が必要です。
うまくくじらが波間に隠れるかどうかがポイントです。がんばってください。
Sub くじらのデート()
Dim Tex(10) As String ’ことばの数
Dim TexName As String
'初期位置
With ActiveSheet.Shapes("はじめ")
.Visible = True
.Left = 260
.Top = 40
End With
With ActiveSheet.Shapes("おわり")
.Visible = False
.Left = 260
.Top = 60
End With
With ActiveSheet.Shapes("くじら１")
.Left = 500
.Top = 200
End With
With ActiveSheet.Shapes("くじら２")
.Left = 70
.Top = 200
End With
With ActiveSheet.Shapes("ことば１")
.Visible = False
.Left = 500
.Top = 100
End With
With ActiveSheet.Shapes("ことば２")
.Visible = False
.Left = 50
.Top = 100
End With
'言葉の読み込み
For k = 1 To 10
Tex(k) = Cells(k, 14) '１４は言葉を書いた列番号。
Next
On Error GoTo Myend
m = 1
'接近の繰り返し
For L = 1 To 8
'くじら１浮上
ActiveSheet.Shapes("くじら１").Select
For n = 200 To 150 Step -1
Selection.ShapeRange.Top = n
Mytimer (0.05)
Next
'言葉の表示
ActiveSheet.Shapes("ことば１").Visible = True '表示
TexName = "ことば１"
GoSub Comv
Mytimer (3)
ActiveSheet.Shapes("ことば１").Visible = False '非表示
'潜水
ActiveSheet.Shapes("くじら１").Select
For n = 150 To 200
Selection.ShapeRange.Top = n
Mytimer (0.05)
Next
'くじら２浮上
ActiveSheet.Shapes("くじら２").Select
For n = 200 To 150 Step -1
Selection.ShapeRange.Top = n
Mytimer (0.05)
Next
ActiveSheet.Shapes("ことば２").Visible = True '表示
TexName = "ことば２"
GoSub Comv
Mytimer (3)
ActiveSheet.Shapes("ことば２").Visible = False '非表示
'潜水
ActiveSheet.Shapes("くじら２").Select
For n = 150 To 200
Selection.ShapeRange.Top = n
Mytimer (0.05)
Next
If m > 10 Then '言葉の終了
GoTo Myend
End If
移動
Next
Comv:
ActiveSheet.Shapes(TexName).Visible = True '表示
ActiveSheet.Shapes(TexName).Select
Selection.Characters.Text = Tex(m)
m = m + 1
Return
Myend:
'タイトル入れ替え
ActiveSheet.Shapes("はじめ").Visible = False
ActiveSheet.Shapes("おわり").Visible = True
Cells(1, 1).Select
End Sub
’－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'接近
Sub 移動()
'くじら１移動（左）
With ActiveSheet
.Shapes("くじら１").Left = .Shapes("くじら１").Left - 80
.Shapes("ことば１").Left = .Shapes("ことば１").Left - 80
'くじら２移動（右）
.Shapes("くじら２").Left = .Shapes("くじら２").Left + 80
.Shapes("ことば２").Left = .Shapes("ことば２").Left + 80
End With
End Sub
’－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'時間調整
Sub Mytimer(t)
mytime = Timer
Do Until Timer > mytime + t
DoEvents
Loop
End Sub
これですべて完成です。
思うようにくじらが会話をしながら浮かんだりもぐったりすれば成功です。
これを応用して、神出鬼没なシーンを考えて楽しんでください。
では、また、次回まで・・・