[VBA]エクセルでゲームを作ってみた(糸通し編)[1/2]

セキュリティルームはシステムエンジニアにとっての精神と時の部屋である。
　　　　　　　　　　　　　　　　　　　　　　 ～えんちゃ～

セキュリティルームの作業ってめーっちゃ退屈なんですよ。

1. まずスマホ等電子機器の持ち込み禁止！
   セキュリティルームはお客様の重要情報を扱うから情報を持ち出さないように禁止されています。
   基本的に持ち込めるのは紙とペンだけだったりします
   （メモを書いて持ち出せる気がするけど、そこは触れていけないところ)
2. あんまりやることがない
   大体プログラムは前もって作っていて、
   基本的にセキュリティルームではそのプログラムを流すだけだったりします。
   だから楽なんですけどデータが数億件とか有る場合、ひたすら終わるのを待つだけになります。
3. インターネットにつながらない
   お客様情報を扱うので当然脅威はできるだけ排除しなければなりません。
   そのため、作業するパソコン自体にウイルスが入らないようにネットに繋がっていなくて、
   入っているのはメモ帳とエクセルだけなんてこともしばしば

暇すぎて現実世界の1分が、この空間では1時間に感じる性質を持つ、
まさに精神と時の部屋。

なので、暇なのに暇つぶしがないという極限状態に追い込まれてしまいます
だからこそ今あるものだけで精神が崩壊する前に暇をつぶさなきゃいけない

前置きが長くなりましたけど、タイトル。

※自己責任でお願いします。
ちょっとまって糸通しって知ってます？大昔にはやったＦＬＡＳＨゲームです

以前VBAでアニメーションを作ったと思いますが、
今回もこれを使っていきます。

以前記事で書いた
これ、[VBA]アニメーションを作ってみた
フル活用していきましょう。

まず長くないので、実行手順だけ先に書いていきます。
そのあとで、プログラムの解説をしていきます。
①【開発タブ > VisualBasic 　：　 挿入 > 標準モジュール】表示されたシートにStartマクロ、Changeマクロを書き込む

 
Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
'グローバル変数'
Dim f As Double

Sub Start()
	Dim t As Long
	Dim pos As Double
	Dim ra As Integer
	f = 0.2
	v = 0#
	pos = 6#
	t = 6
	Randomize
	'初期設定'
	Cells.ClearContents
	ActiveWindow.ScrollRow = 6
	'障害物配置'
	For obst = 50 To 1000 Step 50
		ra = Int(Rnd() * 80)
		For x = 1 To 100
			If (Not (ra < x And x < ra + 20)) Then
				Cells(obst + 50, x) = "■"
			End If
		Next x
	Next obst
	
	'3秒待機'
	DoEvents
	Sleep 3000

	'ゲーム開始'
	Do
		'オイラー法'
		v = v + f
		pos = pos + v

		'ゲームオーバー処理'
		If (pos < 1 Or pos > 101) Then
			MsgBox "GAME OVER"
			End
		End If
		If (Cells(t, Int(pos)) = "■") Then
			MsgBox "GAME OVER"
			End
		End If

		'現在の場所を記入'
		Cells(t, Int(pos)) = "○"

		'クリア処理'
		If (1020 < t) Then
			MsgBox "CLEAR"
			End
		End If

		'更新する'
		t = t + 1

		'画面スクロールを行う'
		If (t > 30) Then
			ActiveWindow.SmallScroll Down:=1
		End If

		'更新待機処理'
		DoEvents
		Sleep 20
	Loop
End Sub

Sub Change()
	'加速度の変更'
	f = f * -1#
End Sub

次にエクセルの設定です。

開発タブから

[クリックで拡大]

面倒くさがりは、Changeの下にこれを記入して実行してください(笑

 
Sub Setting()
	Cells.ColumnWidth = 0.62
	Cells.RowHeight = 9
	ActiveWindow.DisplayGridlines = False
	Rows("6:6").Select
	ActiveWindow.FreezePanes = True
	With Columns("CX:CX").Borders(xlEdgeLeft)
		.LineStyle = xlContinuous
		.Weight = xlThick
	End With
	
	ActiveSheet.Buttons.Add(150, 20, 50, 20).Select
	Selection.Characters.Text = "Start"
	Selection.OnAction = "Start"
	
	ActiveSheet.Buttons.Add(230, 20, 50, 20).Select
	Selection.Characters.Text = "Click"
	Selection.OnAction = "Change"
End Sub

これで完成です。STARTボタンでゲームが開始し、Clickボタンで曲がるようになりました。

次回、プログラムの説明します。
>[プログラム解説編]