その昔 倉庫番 というゲームがありました。
Excelで完全に再現することは不可能ですが、できるだけ再現してみたいと思います。
ゲームプログラミングを勉強したい方には、あまり参考にならないと思います。
しかし、VBAの学習に多少寄与できるよう無駄なことをしながら挑戦してみます。
途中で挫折するかもしれませんので、ご承知ください。
作業者の移動をどう実現するか
前回記事の続きです。
矢印キーが押されたことは感知できるようになったので、実際に作業者を移動する機能の実装をしていきます。
どう実現するか？ってシェイプを動かすんでしょ、というのは正論なんですがもっと単純化して実装したいです。
おそらく、実際のゲームでは画像をちょっとずつ動かしてなめらかなアニメーションを実現していると思います。
ただ、作業者は押されたキーによって切り替える４つのシェイプのみで、のちに実装する荷物の移動については目的地に到着すると切り替える画像くらいしか用意しておらず、なめらかなアニメーションのための画像は用意していません。
なめらかなアニメーションの再現はあきらめて、現在地のシェイプを削除してとなりのセルにCopy&Pasteする形で移動を実装します。
とりあえず制約なしに作業者を移動する
最終的にはゲームのルールという制約のもとに移動させるのですが、まずただ移動するだけの単純な機能の実装を行います。
上記の通り
- 現在地のシェイプを削除
- 矢印キー方向のとなりのセルを取得
- となりのセルにシェイプを生成
コードを作ります。
セルを移動するといえば、行番号・列番号から計算してもいいのですが、有名なのはOffsetプロパティです。
使ったことがない方に向けて使い方例を説明します。
こちらもよく使いますが、Endプロパティで現在の入力最終行を取得できます。
lngLastRow = ActiveCell.End(xlDown).Row
これにOffsetを使って続けて入力を開始する行、すなわち最終行の１つ下の行を取得できます。
lngResmRow = ActiveCell.End(xlDown).Offset(1).Row
今回は Offset を使って、移動先のセルを取得します。
現在セルと移動方向を引数（パラメータ）とし、移動後のセルを返す関数を作成します。
なお、移動方向とテンプレートのシェイプ名は同一になるよう用意しています。
'---------------------------------------------------------------------- ' fnTempFunc ' 引数 = in_objSheet : シートオブジェクト ' 引数 = in_objRange : 移動前セルのオブジェクト ' 引数 = in_strDrct : 移動方向 -> 上or右or下or左 ' 戻り値 = 移動後のセル（オブジェクト） '---------------------------------------------------------------------- Function fnTempFunc(in_objSheet As Worksheet, _ in_objRange As Range, in_strDrct As String) As Range '作業者の既存シェイプを削除 in_objSheet.Shapes(C_SHAPE_WHS_PRSN).Delete '移動後のセルを戻り値にセット With in_objRange Select Case in_strDrct Case "上" Set fnTempFunc = .Offset(-1, 0) Case "下" Set fnTempFunc = .Offset(1, 0) Case "左" Set fnTempFunc = .Offset(0, -1) Case "右" Set fnTempFunc = .Offset(0, 1) End Select End With '移動先に作業者シェイプを生成 Call sbCreatePic(in_objSheet, fnTempFunc, _ in_strDrct, C_SHAPE_WHS_PRSN) '作業者セルを選択 fnTempFunc.Select End Function
これを Macro2 から呼び出せば、とりあえず作業者を動かせます。
Sub Macro2() Dim objRangePrsn As Range '倉庫作業者のセル Worksheets("Sokoban").Select '初期化 Set objRangePrsn = fnRefresh(ActiveSheet) Do ' 上矢印 If GetAsyncKeyState(vbKeyUp) <> 0 Then Set objRangePrsn = _ fnTempFunc(ActiveSheet, objRangePrsn, "上") End If ' 右矢印 If GetAsyncKeyState(vbKeyRight) <> 0 Then Set objRangePrsn = _ fnTempFunc(ActiveSheet, objRangePrsn, "右") End If ' 下矢印 If GetAsyncKeyState(vbKeyDown) <> 0 Then Set objRangePrsn = _ fnTempFunc(ActiveSheet, objRangePrsn, "下") End If ' 左矢印 If GetAsyncKeyState(vbKeyLeft) <> 0 Then Set objRangePrsn = _ fnTempFunc(ActiveSheet, objRangePrsn, "左") End If ' 「HOME」ボタン リトライ If GetAsyncKeyState(vbKeyHome) <> 0 Then If MsgBox("最初からやり直します", vbOKCancel) = vbOK Then Set objRangePrsn = fnRefresh(ActiveSheet) End If End If ' 「END」ボタン 終了 If GetAsyncKeyState(vbKeyEnd) <> 0 Then If MsgBox("ゲームを終了します", vbOKCancel) = vbOK Then '画像クリア Call sbClearShapes(ActiveSheet) Exit Sub End If End If Sleep 100 DoEvents Loop End Sub
実際に作業者を動かしてみると
これで実際に作業者を動かしてみました。
セルのないところへ動かそうとすると ABnormal-END することは想定内なのですが、ひとつ想定外のことが起こりました。
それはシェイプがあるところに作業者を移動したときです。
壁や目的地のシェイプの上に作業者シェイプが生成されると思っていたのですが、ずれて貼り付けられました。
「壁」や「荷物」はゲームの制約の関係で最終的には重ならないのですが、作業者と目的地は重なることがあります。
このため、「作業者が目的地に移動したら、目的地シェイプを消す」および「作業者が目的地から移動したら、目的地シェイプを復活する」という処理も実装する必要があることがわかりました。
次回以降に追加実装していきます。
となりのセルを取得する機能をクラスに移植
VBAの経験があってもクラスモジュールを作ったことがないという方もいると思います。
かくいう私もクラスモジュールを作ったことはありません。
私自身の学習もかねて、となりのセルを取得するところをクラスに移植してみます。
まずはクラスモジュールを作成し、名前を clsCell としました。
プロパティやメソッドのコードの前に、少しばかりクラスのイベントに触れます。
VBEのコンボボックスで、オブジェクトに「Class」を選ぶと、プロシージャに「 Initialize 」と「 Terminate 」が選べるようになり、選択するとそれぞれのサブルーチンコードが生成されます。
ともに今回は使用しませんが、外部コードから明示的に呼び出されることなくイベントドリブンで実行されます。
Initializeイベントは、クラスインスタンスの生成時に実行されるもので、プロパティに初期値を設定するなどに使われます。
Terminateイベントは、クラスインスタンスが破棄されるときに実行されます。一般的な使い方は分かりませんが、処理が完了したセルに色を塗るといった使い方ができそうです。
クラスモジュールに記述したコードの紹介です。
Option Explicit ' ===== プロパティ ===== '現在地の情報 Public oRange_0 As Range '現在セル 'ひとつ先の情報 Public oRange_1 As Range 'ひとつ先のセル '移動方向 Public sDrct As String '移動方向 -> 上or右or下or左 ' ===== メソッド ===== '---------------------------------------------------------------------- ' sbNextCell ' １つ指定方向先に移動したセルをプロパティにセットする '---------------------------------------------------------------------- Public Sub sbNextCell() '移動先セルを取得 With oRange_0 Select Case sDrct Case "上" Set oRange_1 = .Offset(-1, 0) Case "下" Set oRange_1 = .Offset(1, 0) Case "左" Set oRange_1 = .Offset(0, -1) Case "右" Set oRange_1 = .Offset(0, 1) End Select End With End Sub
クラス内の変数の接頭語は１文字にして、"o"がオブジェクトで"s"が文字であることを意味します。
モジュールレベル領域にPublicで変数を宣言することで、簡易的にプロパティを設定できます。
プロパティには配列を設定できないため、現在地ととなりのセルのそれぞれにプロパティを用意しています。
プロパティについてはのちほどまた触れます。
となりのセルを取得するメソッドを用意しています。
メソッドには引数（パラメータ）も戻り値も設定することができますが、今回は引数も戻り値もプロパティにセットすることとしました。
クラスのプロパティ
さきほど簡易的なプロパティ設定といいましたが、きちんと設定するとどうなるか確認します。
例えば、移動方向のプロパティ "sDrct" であればこのように設定します。
Option Explicit Private sDrct_ As String '---------------------------------------------------------------------- ' プロパティ : sDrct ' 移動方向 -> 上or右or下or左 '---------------------------------------------------------------------- 'プロパティ値の書き込み Public Property Let sDrct(ByVal p_Drct As String) sDrct_ = p_Drct End Property 'プロパティ値の読み取り Public Property Get sDrct() As String sDrct = sDrct_ EndProperty
変数宣言だけで済んでいたものが、かなり面倒になりました。
こんなことやらないよと思ってしまいますが、このような形式で記述することでプロパティ値の自由度の制限が可能になります。
私はクラスモジュールを作成したことはありませんが、（VBAではありませんが）提供を受けて利用したことはあります。
いわゆる標準モジュールにある（よく使う）共通関数の提供を受ける場合もそうですが、提供される資料を確認するだけでコード自体を確認することはありません。
自分以外の人がクラスを利用するとき、想定していないプロパティの使われ方は想定外の動きを引き起こすリスクがあります。
できる限りプロパティには制限を加えておくことが望ましいのです。
例えば、今回 oRange_0 を引数（パラメータ）として oRange_1 を戻り値として設定しています。
資料を読めばこのようなことはないのですが、仮に逆にしてしまうとメソッドではひとつ先のセルを取得できません。
そこで、o_Range_0を外部からの設定のみが可能なプロパティに、o_Range_1を外部からの値の取得のみが可能なプロパティに設定できます。
Option Explicit Private sDrct_ As String Private oRange_0_ As Range Private oRange_1_ As Range ' ===== プロパティ ===== '---------------------------------------------------------------------- ' プロパティ : sDrct ' 移動方向 -> 上or右or下or左 '---------------------------------------------------------------------- 'プロパティ値の読み取り Public Property Let sDrct(ByVal p_Drct As String) sDrct_ = p_Drct End Property 'プロパティ値の書き込み Public Property Get sDrct() As String sDrct = sDrct_ End Property '---------------------------------------------------------------------- ' プロパティ : oRange_0 ' 現在セル、外部からの設定のみ可 '---------------------------------------------------------------------- 'プロパティ値の書き込み Public Property Set oRange_0(ByVal p_oRange_0 As Range) Set oRange_0_ = p_oRange_0 End Property '---------------------------------------------------------------------- ' プロパティ : oRange_1 ' ひとつ先のセル、外部からの参照のみ可 '---------------------------------------------------------------------- 'プロパティ値の読み取り Public Property Get oRange_1() As Range Set oRange_1 = oRange_1_ End Property ' ===== メソッド ===== '---------------------------------------------------------------------- ' sbNextCell ' １つ指定方向先に移動したセルをプロパティにセットする '---------------------------------------------------------------------- Public Sub sbNextCell() '移動先セルを取得 With oRange_0_ Select Case sDrct Case "上" Set oRange_1_ = .Offset(-1, 0) Case "下" Set oRange_1_ = .Offset(1, 0) Case "左" Set oRange_1_ = .Offset(0, -1) Case "右" Set oRange_1_ = .Offset(0, 1) End Select End With End Sub
このコードで試しに oRange_1 に現在セルをセットしてメソッドを動かすと AB-END します。
私の例が下手でどのように自由度を制限するのか理解できなかったかもしれませんが、面倒なコードにも意味があることを知っておくだけでも意味があると思います。
勉強はここまでとして、今回は非常に簡単なクラスであることに加えクラスを使用するのは自分だけなので、簡易的なプロパティ設定で進めていきます。
次回は、新たな課題となった目的地の処理とゲームのルールによる移動制約条件を検討します。
ご質問は下の 「コメントを書く」 からお願いします。
ExcelやVBA全般に関わる質問で、比較的簡単にお答えできるものはできる限り回答したいと思います。
回答を公開でなくメールでやり取りしたいという場合は、その旨記載していただければ非公開で回答することも可能です。
有償での作業依頼は非公開にしますので、条件等をお知らせください。
