Excel/VBAでパックマンを作る

Excel方眼紙を使ってパックマンを作ってみました。

まだゲームとしては成り立っておらず、壁も敵キャラもいません。単に矢印キーでパックマンが上下左右に動くだけですね。壁もこれからです。

とりあえず、パックマンを矢印キーで動かすような基本的なところを押さえました。

[ad#top-1]

動画でみるExcelパックマン

動画でざっとした動きを紹介します。上下左右に動いていますがパソコンの矢印キーで動かしています。

https://www.youtube.com/watch?v=UZBVtckFgFM

動画にはありませんが、実際は赤丸で示したフォームが現れます。こいつが矢印キーをキャッチしてくれるんですね。シート上ではキーイベントが拾えないみたいなので。フォームをダブルクリックすると終了します。

ソースコード

まだ、パックマンのキー操作だけですが、ソースコードを書き留めておきます。もう少し完成度が上がったらGitHubにアップします。

Startボタン押下時

Excelシート右上の「Start」ボタンを押すとパックマンが開始されます。

開始コードは以下の通り。まずは4行目にスタート時のパックマンを描画します。座標と、”RIGHT”というのは「右向き」という意味です。

Sub start()
  Range("A2:ZZ200").Interior.Pattern = xlNone

  Call packman(7, 7, "RIGHT") 'パックマンの描画　座標(7,7)
  Call UserForm1.setPos(7, 7) 'フォームに開始座標をセット
  UserForm1.Show 'フォーム起動
End Sub
 

packmanプロシージャ

パックマンを描画するプロシージャは下記の通りです。pack配列はパックマンを描画するためのデータです。右向き、左向き、上向き、下向きのそれぞれに対応しています。描画前に1セル後ろの1列分の色を消しているので、あたかも進んでいるように見えるってわけですね。

Sub packman(posx, posy, direct)
  Dim pack As Variant

  If direct = "RIGHT" Then
    If posx > 150 Then Exit Sub
    pack = Array( _
           Array(0, 0, 1, 1, 0), _
           Array(0, 1, 1, 1, 1), _
           Array(1, 1, 1, 0, 0), _
           Array(0, 1, 1, 1, 1), _
           Array(0, 0, 1, 1, 0) _
          )
    Range(Cells(posy - 2, posx - 3), Cells(posy + 2, posx - 3)).Interior.Pattern = xlNone
  ElseIf direct = "LEFT" Then
    If posx < 7 Then Exit Sub
    pack = Array( _
           Array(0, 1, 1, 0, 0), _
           Array(1, 1, 1, 1, 0), _
           Array(0, 0, 1, 1, 1), _
           Array(1, 1, 1, 1, 0), _
           Array(0, 1, 1, 0, 0) _
           )
         Range(Cells(posy - 2, posx + 3), Cells(posy + 2, posx + 3)).Interior.Pattern = xlNone
  ElseIf direct = "UP" Then
    If posy < 7 Then Exit Sub 
    pack = Array( _ 
           Array(0, 1, 0, 1, 0), _ 
           Array(1, 1, 0, 1, 1), _ 
           Array(1, 1, 1, 1, 1), _ 
           Array(0, 1, 1, 1, 0), _ 
           Array(0, 0, 1, 0, 0) _ 
           ) 
    Range(Cells(posy + 3, posx - 2), Cells(posy + 3, posx + 2)).Interior.Pattern = xlNone 
  ElseIf direct = "DOWN" Then 
    If posy > 70 Then Exit Sub
    pack = Array( _
           Array(0, 0, 1, 0, 0), _
           Array(0, 1, 1, 1, 0), _
           Array(1, 1, 1, 1, 1), _
           Array(1, 1, 0, 1, 1), _
           Array(0, 1, 0, 1, 0) _
           )
    Range(Cells(posy - 3, posx - 2), Cells(posy - 3, posx + 2)).Interior.Pattern = xlNone
  End If

  For i = 0 To UBound(pack)
    For j = 0 To UBound(pack(i))
      If pack(i)(j) = 1 Then
        Cells(posy - 2 + i, posx - 2 + j).Interior.Color = 49407
      Else
        Cells(posy - 2 + i, posx - 2 + j).Interior.Pattern = xlNone
      End If
    Next j
  Next i

  Call UserForm1.setPos(posx, posy)
End Sub
 

UserForm

スタートボタンを押したときに各矢印キーに応じて座標を指定しつつ前出のpackmanプロシージャを呼び出しているわけです。

Dim lastposx As Integer
Dim lastposy As Integer
Sub setPos(x, y)
  lastposx = x
  lastposy = y
End Sub

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = vbKeyUp Then
    Call packman(lastposx, lastposy - 1, "UP")
  ElseIf KeyCode = vbKeyDown Then
    Call packman(lastposx, lastposy + 1, "DOWN")
  ElseIf KeyCode = vbKeyLeft Then
    Call packman(lastposx - 1, lastposy, "LEFT")
  ElseIf KeyCode = vbKeyRight Then
    Call packman(lastposx + 1, lastposy, "RIGHT")
  End If
End Sub
 

とりあえずこんな感じです。今後は迷路みたいな壁を作ってそこを通るような動きをさせようと思います。

※続編です。

非IT企業に勤める中年サラリーマンのIT日記

Excel/VBAでパックマンを作る--壁と点数付け

前回に続き、Excel方眼紙を使ったパックマンを製作中です。今回は壁を作って迷路上をパックマンが動くようにしたことと、ポイントを食べて点数が上がるようになっています。前回同様、パックマンはパソコンの矢印キーで動きます。ソースコードはGitHubにて公開しております。順次更新していきますが、現時点のソースコードは「packman_main_20170923.bas」となります。GitHub: satoshi71/ExcelPackmanあと、動画をYoutubeにアップしましたので動きをご覧ください。https://www.youtube.com/watch?v=0AduSpuhaT0&t=1s 動作説明...

https://www.youtube.com/watch?v=0AduSpuhaT0

[ad#ad-1]

 - Excel, VBA