【EXCELでローグを作る】第１回アクティブセルを移動する

MS-OfficeにはVBAがついている！と言う事でVBAを駆使してEXCELで遊んでみようと思います。

さて、何を作るのか？ローグタイプのゲーム作りにチャレンジします！

気長な挑戦になると思いますが、頑張ってやっていこうと思います。

アクティブセルの移動

まずは自キャラの移動を作ってみます。まずはアクティブセルを自キャラに見立てて、アクティブセルを移動させてみたいと思います。

移動ボタンの作成

Excelのカーソル位置を自キャラに見立てて移動を実現したいと思います。カーソルキーで移動かなぁと思いましたが、斜め移動が面倒だと言う事で8方向への移動ボタンを設置する事に。

移動ボタン

おお〜クラシック（笑）こんなので良いんです。

このボタンにそれぞれ別々のイベントを紐づけておきます。そのイベント先でカーソルの移動を実装すれば良い訳ですね。

アクティブセル移動の実装

カーソルの移動は次のプロパティと２つのメッドを利用します。

ActiveCellから移動量分オフセットさせたセルをActiveにすれば見た目としてはアクティブセルが移動した様に見えます。

次の命令で実行可能です。

ActiveCell.offcet(dx,dy),Activate

dx,dy=移動量になります。今回は上、左上、左、左下、下、右下、右、右上の8方向になるので、それぞれの行と列の移動量をoffcetメソッドに与えます。

具体的な数値は次になりますね。

上：dx=0,dy=-1
左上：dx=1,dy=-1
左：dx=1,dy=0
左下：dx=1,dy=1
下：dx=0,dy=1
右下：dx=-1,dy=1
右：dx=-1,dy=0
右上：dx=-1,dy=-1

では実装です。

Option Explicit

'' 上に移動
Sub U_Click()
    ActiveCell.Offset(-1, 0).Activate
End Sub

'' 右上に移動
Sub UR_Click()
    ActiveCell.Offset(-1, 1).Activate
End Sub

'' 右に移動
Sub R_Click()
    ActiveCell.Offset(0, 1).Activate
End Sub

'' 右下に移動
Sub DR_Click()
    ActiveCell.Offset(1, 1).Activate
End Sub

'' 下に移動
Sub D_Click()
    ActiveCell.Offset(1, 0).Activate
End Sub

'' 左下に移動
Sub LD_Click()
    ActiveCell.Offset(1, -1).Activate
End Sub

'' 左に移動
Sub L_Click()
    ActiveCell.Offset(0, -1).Activate
End Sub

'' 左上に移動
Sub UL_Click()
    ActiveCell.Offset(-1, -1).Activate
End Sub

各メソッドにそれぞれの移動量を実装しました。

それでは動作検証してみます。

上ボタンを押してみます。現在アクティブセルはD10です。

移動前（D10）

上ボタンを押下するとD9に移動しました。

成功ですね！！

カーソルが上に移動（D9）

ボタンとイベントを組み合わせてアクティブセルの移動が可能となりました。

一番上まで行ったらエラーが出た

さて上ボタンを押し続けて1行目までいったらどうなるのでしょうか？

やってみましょう！

ここにいると

エラー！

エラーが出てプログラムが終了してしまいました。

セルの位置が範囲外になってしまった為ですね。という事で移動してもセルが範囲内にあるかどうかを判定して、移動可能なら実行する様にしてあげる必要がありそうです。

ActiveCellプロパティが保持するアクティブセルの情報を利用します。

RowプロパティとColumnプロパティはセルの位置情報が格納されています。

AcitveCellのRowとColumnを参照して現在の位置を判定した上で、移動可能かどうかを判定すれば良いと言う訳です。

具体的には上ボタンなら今の行が一番上ではなかった移動する様にすれば良いんですね。ある条件の時だけ実行したい場合はIf文の登場ですよね。

If 条件式 Then
    条件式がTrueの時の実行文
Else
 　　　　　　条件式がFalseの時の実行文
End If

と言う訳で実装です（ここでは上限を10にしているので、10×10の範囲でアクティブセルが移動出来るようになります）。

Option Explicit

'' 上に移動
Sub U_Click()
    If 1 < ActiveCell.Row Then
        ActiveCell.Offset(-1, 0).Activate
    End If
End Sub

'' 右上に移動
Sub UR_Click()
    If 1 < ActiveCell.Row And ActiveCell.Column < 10 Then
        ActiveCell.Offset(-1, 1).Activate
    End If
End Sub

'' 右に移動
Sub R_Click()
    If ActiveCell.Column < 10 Then
        ActiveCell.Offset(0, 1).Activate
    End If
End Sub

'' 右下に移動
Sub DR_Click()
    If ActiveCell.Row < 10 And ActiveCell.Column < 10 Then
        ActiveCell.Offset(1, 1).Activate
    End If
End Sub

'' 下に移動
Sub D_Click()
    If ActiveCell.Row < 10 Then
        ActiveCell.Offset(1, 0).Activate
    End If
End Sub

'' 左下に移動
Sub LD_Click()
    If ActiveCell.Row < 10 And 1 < ActiveCell.Column Then
        ActiveCell.Offset(1, -1).Activate
    End If
End Sub

'' 左に移動
Sub L_Click()
    If 1 < ActiveCell.Column Then
        ActiveCell.Offset(0, -1).Activate
    End If
End Sub

'' 左上に移動
Sub UL_Click()
    If 1 < ActiveCell.Row And 1 < ActiveCell.Column Then
        ActiveCell.Offset(-1, -1).Activate
    End If
End Sub

では動作です。

一番上で上への移動ボタンを押します。

一番上

ポチっ！

コレ以上移動しない！

代り映えしませんが、変なエラーがでなくなっています。

と言うわけで、今回はここまで！！

次は自キャラをカーソルではなく、ローグっぽく「＠」にして移動する様にしてみましょう！！

次回をお楽しみに！！