ロボ太がブロックを避けるだけのゲーム【ExcelVBA】

【ライブ配信テスト】VBAでブロックが落ちてくるゲームを作成（無言） - YouTube

使用したサンプルコード

---

Option Explicit
'押されたキーを判定するAPI
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
'指定した時間中断するAPI
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
'音声ファイルを再生するAPI
Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'ロボの行と列の変数
Dim roboRow As Integer
Dim roboCol As Integer
'ブロックの行と列の変数
Dim blkRow As Integer
Dim blkCol As Integer
'2個目ブロックの行と列の変数
Dim blkRow2 As Integer
Dim blkCol2 As Integer
'2個目ブロックの行と列の変数
Dim blkRow3 As Integer
Dim blkCol3 As Integer
'フラグのブール値の定義
Dim flg As Boolean
'時間表記用の変数
Dim tim As Double
Public Sub Main()

'最初の位置は９の５
roboRow = 9
roboCol = 5

'スタート時間
tim = 0
Range("C10").Value = ""

'音楽再生
mciSendString "play " & "music2.mp3", "", 0, 0

'ブロックの最初の位置
blkRow = Application.WorksheetFunction.RandBetween(1, 5)
blkCol = Application.WorksheetFunction.RandBetween(2, 8)

'2個目のブロックの最初の位置
blkRow2 = Application.WorksheetFunction.RandBetween(1, 5)
blkCol2 = Application.WorksheetFunction.RandBetween(2, 8)

'3個目のブロックの最初の位置
blkRow3 = Application.WorksheetFunction.RandBetween(1, 5)
blkCol3 = Application.WorksheetFunction.RandBetween(2, 8)

'最初flgはFalse
flg = False

'常にループ
Do While flg = False

'1マスブロックを下げる
blkRow = blkRow + 1
blkRow2 = blkRow2 + 1
blkRow3 = blkRow3 + 1

'１０マスにいったら２に戻す
If blkRow = 10 Then
blkRow = 2
blkCol = Application.WorksheetFunction.RandBetween(2, 8)
End If

'１０マスにいったら２に戻す
If blkRow2 = 10 Then
blkRow2 = 2
blkCol2 = Application.WorksheetFunction.RandBetween(2, 8)
End If

If blkRow3 = 10 Then
blkRow3 = 2
blkCol3 = Application.WorksheetFunction.RandBetween(2, 8)
End If

'上からのマス・左からのマスを選択する
Cells(roboRow, roboCol).Select

'アクティブセルにロボ太が動く形にする
ActiveSheet.Shapes("ロボ太").Left = ActiveCell.Left
ActiveSheet.Shapes("ロボ太").Top = ActiveCell.Top

'ブロックを移動する
Cells(blkRow, blkCol).Interior.Color = 1
Cells(blkRow2, blkCol2).Interior.Color = 1
Cells(blkRow3, blkCol3).Interior.Color = 1

'ボタンを判定する 対象のキーが押されていたら0以外を返す
If GetAsyncKeyState(37) <> 0 Then
'左に移動する
roboCol = Application.WorksheetFunction.Max(2, roboCol - 1)
ElseIf GetAsyncKeyState(39) <> 0 Then
'右に移動する
roboCol = Application.WorksheetFunction.Min(8, roboCol + 1)
ElseIf GetAsyncKeyState(27) <> 0 Then
'flgをTrueにしてあげる
flg = True
End If

'0.1秒待機
Sleep 100
'OSに制御を渡す
DoEvents

'タイマーを設定
tim = tim + 0.1
Range("C10").Value = Int(tim) & "秒"

'当たり判定　キャラはアクティブセル
If ActiveCell.Address = Cells(blkRow, blkCol).Address _
Or ActiveCell.Address = Cells(blkRow2, blkCol2).Address _
Or ActiveCell.Address = Cells(blkRow3, blkCol3).Address _
Then
Exit Do
End If

'ブロックを消去する
Cells(blkRow, blkCol).Interior.Color = xlNone
Cells(blkRow2, blkCol2).Interior.Color = xlNone
Cells(blkRow3, blkCol3).Interior.Color = xlNone
Loop

'ゲーム終了
MsgBox Range("C10").Value & "でした"
Range("B2", "H9").Interior.Color = xlNone
mciSendString "stop " & "music2.mp3", "", 0, 0

End Sub