見出し画像

Excelを使ったゲームのつくり方!Excelで動くブロック崩し~コピペで使えるExcelマクロ~

以下の記事で、OpenAIの最新モデル「o3-mini-high」について紹介しました。この記事で紹介した、「o3-mini-high」が実際に一発で作ったブロック崩しゲームを紹介します。

OpenAIの最新モデル「o3-mini-high」については、以下の記事を確認ください

Excelマクロの基本的な使い方は、下の記事を参考にしてください


1. マクロの概要

このマクロは、Excel のワークシート上にシェイプを配置し、それらをブロック崩しゲームのブロック、ボール、パドルとして扱います。ユーザーはキーボードの左右キーでパドルを操作し、ボールを跳ね返しながらブロックを破壊します。

主な機能は以下の通りです。

  • ブロックの配置

  • パドルの作成と操作

  • ボールの動作(衝突判定と反射)

  • ゲームの勝敗判定

動画はこちらになります。

現役ITコンサルが教えるExcel超自動化術 on Instagram: "現役のITコンサルタントが業務効率化のテクニックを紹介します。 ExcelVBAを使うと、Excel上でゲームだって作れちゃいます! 遊んでみたい方は、フォローといいね👍でExcelファイルをプレゼント 他の投稿はこちら👉 @dk_excel 質問はコメントまたは、DMまで💡 今回紹介したマクロは、以下の手順でプレゼント 1.このアカウントをフォロー 2.いいね or コメントでリアクション 3.DMでダウンロードリンクを配布 ____________________________ このアカウントは Excelマクロ等の配布や作業効率をアップさせるテクニックを紹介して、すべての人の業務効率化を支援します! ぜひ、実践して自由時間を増やしてください! 参考になった方は、フォローと👍をお願いします! #excelスキル #excel初心者 #excelスキルアップ #excelマクロ #excelマクロ作成 #pcスキル #pcスキルアップ #業務効率 #業務効率アップ #エクセルスキル #エクセルスキル向上 #エクセルマクロ #エクセルマクロ講座#エクセル #エクセル時短ワザ #Excel#作業効率化 #vba#エクセルvba#excelvba#パソコンスキル #パソコンスキルアップ #仕事効率化#エクセル関数 #エクセル初心者#仕事術#マクロ#エクセルマクロ#excelマクロ#仕事の悩み" 0 likes, 0 comments - dk_excel on January 31, 2025: "現役のITコンサ www.instagram.com

2. コードの説明

以下が今回紹介するVBAコードです。ExcelのVBAエディタに貼り付けて使います。

#If VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Sub BlockBreaker()
    ' ゲーム領域のサイズ(単位:ポイント)
    Dim gameWidth As Single, gameHeight As Single
    gameWidth = 600
    gameHeight = 500
    
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim shp As Shape
    ' 既存の図形を一掃(※他の図形がある場合は注意)
For Each shp In sh.Shapes
    If Left(shp.Name, 6) = "Block_" Or shp.Name = "Paddle" Or shp.Name = "Ball" Then
        shp.Delete
    End If
Next shp
    
    '■■■【ブロック生成】■■■
    Dim blockRows As Integer, blockCols As Integer
    blockRows = 5
    blockCols = 10
    Dim blockWidth As Single, blockHeight As Single, spacing As Single
    blockWidth = 50
    blockHeight = 20
    spacing = 5
    Dim marginLeft As Single, marginTop As Single
    marginLeft = 25
    marginTop = 25
    Dim i As Integer, j As Integer
    Dim blockLeft As Single, blockTop As Single
    For i = 0 To blockRows - 1
        For j = 0 To blockCols - 1
            blockLeft = marginLeft + j * (blockWidth + spacing)
            blockTop = marginTop + i * (blockHeight + spacing)
            Set shp = sh.Shapes.AddShape(msoShapeRectangle, blockLeft, blockTop, blockWidth, blockHeight)
            shp.Name = "Block_" & i & "_" & j
            shp.Fill.ForeColor.RGB = RGB(255, 0, 0)  ' 赤色
            shp.Line.Visible = msoFalse
        Next j
    Next i
    
    '■■■【パドル生成】■■■
    Dim paddleWidth As Single, paddleHeight As Single
    paddleWidth = 80
    paddleHeight = 10
    Dim paddleLeft As Single, paddleTop As Single
    paddleLeft = (gameWidth - paddleWidth) / 2
    paddleTop = gameHeight - paddleHeight - 10
    Dim paddle As Shape
    Set paddle = sh.Shapes.AddShape(msoShapeRectangle, paddleLeft, paddleTop, paddleWidth, paddleHeight)
    paddle.Name = "Paddle"
    paddle.Fill.ForeColor.RGB = RGB(0, 0, 255)  ' 青色
    paddle.Line.Visible = msoFalse
    
    '■■■【ボール生成】■■■
    Dim ballDiameter As Single
    ballDiameter = 10
    Dim ballLeft As Single, ballTop As Single
    ballLeft = (gameWidth - ballDiameter) / 2
    ballTop = paddleTop - ballDiameter - 5
    Dim ball As Shape
    Set ball = sh.Shapes.AddShape(msoShapeOval, ballLeft, ballTop, ballDiameter, ballDiameter)
    ball.Name = "Ball"
    ball.Fill.ForeColor.RGB = RGB(0, 255, 0)  ' 緑色
    ball.Line.Visible = msoFalse
    
    '■■■【初期ボール速度設定】■■■
    Dim dx As Single, dy As Single
    dx = 5   ' X軸方向の移動量
    dy = -5  ' Y軸方向(上向き)の移動量
    
    '■■■【ゲームメインループ】■■■
    Dim gameOver As Boolean: gameOver = False
    Dim blockCount As Long
    Dim t As Single
    Do While Not gameOver
        ' ボール移動
        ballLeft = ball.Left + dx
        ballTop = ball.Top + dy
        
        ' 左右の壁との衝突判定
        If ballLeft < 0 Then
            ballLeft = 0
            dx = -dx
        ElseIf ballLeft + ball.Width > gameWidth Then
            ballLeft = gameWidth - ball.Width
            dx = -dx
        End If
        
        ' 上壁との衝突判定
        If ballTop < 0 Then
            ballTop = 0
            dy = -dy
        End If
        
        ' パドルとの衝突判定(ボールが下向きの場合のみ)
        If dy > 0 Then
            If ballTop + ball.Height >= paddle.Top And ballTop + ball.Height <= paddle.Top + paddle.Height Then
                If ballLeft + ball.Width >= paddle.Left And ballLeft <= paddle.Left + paddle.Width Then
                    ballTop = paddle.Top - ball.Height
                    dy = -dy
                End If
            End If
        End If
        
        ' ブロックとの衝突判定
        Dim s As Shape
        For Each s In sh.Shapes
            ' ブロックは名前の先頭が "Block_" になっている
            If Left(s.Name, 6) = "Block_" Then
                If ballLeft + ball.Width >= s.Left And ballLeft <= s.Left + s.Width _
                   And ballTop + ball.Height >= s.Top And ballTop <= s.Top + s.Height Then
                    ' 衝突したブロックを削除し、ボールの進行方向を反転
                    s.Delete
                    dy = -dy
                    Exit For
                End If
            End If
        Next s
        
        ' ボール位置更新
        ball.Left = ballLeft
        ball.Top = ballTop
        
        ' ボールが画面下部(ゲーム領域外)に到達した場合は終了
        If ballTop > gameHeight Then
            gameOver = True
            MsgBox "Game Over"
            Exit Do
        End If
        
        ' 残りブロックがゼロなら勝利
        blockCount = 0
        For Each s In sh.Shapes
            If Left(s.Name, 6) = "Block_" Then blockCount = blockCount + 1
        Next s
        If blockCount = 0 Then
            gameOver = True
            MsgBox "You Win!"
            Exit Do
        End If
        
        '■■■【パドル操作】■■■
        ' 左右キー(VKコード:左=37、右=39)の押下状態を API で取得
        If GetAsyncKeyState(37) <> 0 Then  ' ←キー
            paddle.Left = paddle.Left - 10
            If paddle.Left < 0 Then paddle.Left = 0
        End If
        If GetAsyncKeyState(39) <> 0 Then  ' →キー
            paddle.Left = paddle.Left + 10
            If paddle.Left + paddle.Width > gameWidth Then paddle.Left = gameWidth - paddle.Width
        End If
        
        '■■■【短いウェイト】■■■
        t = Timer
        Do While Timer < t + 0.02
            DoEvents
        Loop
        
        DoEvents
    Loop
End Sub


コードの解説

API の利用

#If VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

この部分では、GetAsyncKeyState API を使って、ユーザーのキーボード入力を検出します。

ゲームエリアの設定と初期化

gameWidth = 600
gameHeight = 500

ゲーム領域のサイズを設定します。

For Each shp In sh.Shapes
    If Left(shp.Name, 6) = "Block_" Or shp.Name = "Paddle" Or shp.Name = "Ball" Then
        shp.Delete
    End If
Next shp

これにより、既存の図形を削除し、新しいゲームの準備をします。

ブロックの配置

For i = 0 To blockRows - 1
    For j = 0 To blockCols - 1
        blockLeft = marginLeft + j * (blockWidth + spacing)
        blockTop = marginTop + i * (blockHeight + spacing)
        Set shp = sh.Shapes.AddShape(msoShapeRectangle, blockLeft, blockTop, blockWidth, blockHeight)
        shp.Name = "Block_" & i & "_" & j
        shp.Fill.ForeColor.RGB = RGB(255, 0, 0)  ' 赤色
        shp.Line.Visible = msoFalse
    Next j
Next i

このループで、5×10のブロックを作成します。

ボールとパドルの設定

Set paddle = sh.Shapes.AddShape(msoShapeRectangle, paddleLeft, paddleTop, paddleWidth, paddleHeight)
paddle.Name = "Paddle"
paddle.Fill.ForeColor.RGB = RGB(0, 0, 255)
paddle.Line.Visible = msoFalse

青色のパドルを作成します。

Set ball = sh.Shapes.AddShape(msoShapeOval, ballLeft, ballTop, ballDiameter, ballDiameter)
ball.Name = "Ball"
ball.Fill.ForeColor.RGB = RGB(0, 255, 0)
ball.Line.Visible = msoFalse

緑色のボールを作成します。

ボールの動作と衝突判定

If ballLeft < 0 Then
    ballLeft = 0
    dx = -dx
End If

ボールが左右の壁に衝突すると、跳ね返ります。

If ballTop > gameHeight Then
    gameOver = True
    MsgBox "Game Over"
    Exit Do
End If

ボールが下まで落ちるとゲームオーバーになります。

ブロックの削除

For Each s In sh.Shapes
    If Left(s.Name, 6) = "Block_" Then
        If ballLeft + ball.Width >= s.Left And ballLeft <= s.Left + s.Width _
           And ballTop + ball.Height >= s.Top And ballTop <= s.Top + s.Height Then
            s.Delete
            dy = -dy
            Exit For
        End If
    End If
Next s

ボールがブロックに当たると、ブロックが削除され、ボールの進行方向が反転します。

3. 使い方

  1. Excel を開き、開発タブから VBA エディタを開きます。

  2. 新しいモジュールを作成し、上記のコードを貼り付けます。

  3. BlockBreaker マクロを実行すると、ブロック崩しゲームが開始します。

  4. 矢印キー(← →)でパドルを動かし、ボールを跳ね返しましょう。

  5. すべてのブロックを消すと勝利、ボールが落ちるとゲームオーバーです。

4. ファイルの配布

実際のファイルも置いておきます。これをダウンロードして使用することも可能です。

5. まとめ

今回のマクロでは、Excel VBA を活用してブロック崩しゲームを作成しました。
興味がある方は、是非遊んでみてください!

※本記事で紹介しているマクロやファイルの使用に伴い発生したいかなるトラブルや損害についても、当方では一切の責任を負いかねます。すべて自己責任のもとでご利用ください。

いいなと思ったら応援しよう!