Excel VBAでユーザーフォーム上にマインスイーパを作る方法
長年Windowsに搭載されてきたおなじみのゲーム「マインスイーパ」。VBAを使ってこれをExcelワークシート上で再現している情報はネットにいくつかありましたが、ユーザーフォームでやっている人は少なかったので、今回やってみました。その方法を紹介しようと思います。
マインスイーパの要件と気をつけるところ
ルールは説明するまでもないと思いますので、ここでは特に触れません。簡単な条件ですが、以下です。マスの数を可変にするのは難しいので今回は決め打ちで9マス×9マス、地雷は10個で固定。
- マスは9マス×9マス
- 地雷の数は10個
- 右クリックで旗を立てる機能はあり
作る上で一番難しいかったのは「地雷がなく、かつ数字でもないマスを開いたらそのマスの周りの全方向を調べて数字があるマスまで全部開く」という部分ですね。これはあとで解説します。
コードの解説
xlsmファイルはこちらにアップしており、ソースコードは記事の最後に書きますが、ポイントとなる部分だけ解説します。
マスの作成
当たり前ですが、まず以下のようにラベルオブジェクトでマスを作っていきます。
今回はラベルの名前は左上から右方向にL1、L2、L3・・・L81としました。フォームのオブジェクト名は「form」、クラスモジュールの名前は「class1」。それ前提で解説を進めていきます。
マスに地雷をセットする
UserForm_Initializeでゲームを始めるのに必要な処理を行います。その1つがラベルへの地雷のセットです。それを行っているのがソースコード中のmineSetプロシージャです。
地雷の場所は変数上で管理します。1から81までランダムな数字を生成してそれを地雷番号として、同じく1から81まで要素をもつ配列変数status()中の番号に対して、もし地雷番号と合致すれば数字の2を格納する処理を行います。
マスに数字をセットする
マインスイーパではマス上に、そのマスの周りに地雷がいくつあるかを示す数字が書いてあります。この情報を格納します。これもマスであるラベルオブジェクトには直接記入しません。１から81まで要素を持つlNum()という配列変数の要素それぞれに、セルに記載する地雷数の数字を格納していきます。
合わせて、先程の配列変数status()にも、地雷数を記入するラベルの番号には数字の1を格納していきます。
この配列変数status()は81個のラベルが、「地雷のラベルか」「数字のラベルか」「何も記入のないラベルか」を判断するためのものです。
どうやってマスの周りの地雷数を数えているか
次に、81個のマスに対してループをかけて地雷数を記入するわけですが、マスをi番とするとその周りの8方向（i - 10, i - 9, i - 8, i - 1, i + 1, i + 8, i + 9, i + 10）のstatusを調べて、それが数字2だったら地雷がある、という判定を行います。
ただ、当然のことながらすべてのマスに対して「8方向を調べる」というロジックは使えません。例えば左上の端のマスは「左、左下、下」の3方向を調べるだけです。
あとから知ったのですが、これを回避するために、端のマスの外にも実際には使わないダミーのマスを設けるという手法があったのですが、このときはそれを知らなかったので、違う方法で行いました。
それが、例えばマスが四隅（マス1、マス9、マス72、マス81）のときは周り3方向を調べ、上端のマスのときは上を除く5方向を調べ・・・というように、探索するマスの方向をselect caseで条件に応じて変えるという地味な手段です。
クリックイベント処理を共通化する
今回は81個のマスがあり、クリックしたら開くというどれも同じ処理を行います。これをどう実装すればよいでしょうか。単純な方法として、以下の画像のようにラベルのクリックイベントを81個分書くという選択肢もあります。
ですが、同じことを何度も書くのでコードとしてはかっこ悪いですね。実はこの煩雑さを解消する方法があるのです。
クラスモジュールとWithEventsというキーワードを使うことで、複数のオブジェクトのイベントを1つのイベントプロシージャに集約できるのです。解説は多く出回っていますが、私が参考にしたのは以下の記事です。
私もいまいち掴みきれていないのですが、私が作ったソースコードを例に、イベント処理を一括化する方法というか理屈を以下に見てみましょう（説明が適切かは不明）
（１）WithEventsキーワードでラベルオブジェクト型の変数myLblを宣言する。
ソースコード内にあるlblSetというプロシージャで、その変数myLblにラベルオブジェクトのインスタンスを突っ込んでいくための処理を書きます（クラスモジュール内の以下の処理）
Public Sub lblSet(ByVal obj As MSForms.Label)
Set myLbl = obj
End Sub
（２）81個分のインスタンスを作る
当然のことながら実際にラベル81個分のインスタンスを変数に入れるには、まずインスタンス作って上記のlblSetを実行することが必要になります。これは、UserForm_Initialize()のプロシージャに書いてあった以下の部分です。
For i = 1 To 81
lblArray(i).lblSet Controls("L" & i)
Next i
※上記３行以外にごちゃごちゃ他の記述もありますが、シンプルにするため上記3行だけあえて抜き出しています。
（３）クラスの宣言をしておく
もちろん、その前にクラスを宣言する必要があるので、ユーザーフォームでも標準モジュールどちらでも良いと思いますが、以下を宣言しておきます。
Public lblArray(1 To 81) As New class1
こうすることで、81個のラベルオブジェクトは、すべてmyLblというオブジェクトになり、クリックとかマウスオーバーとか、ラベルオブジェクトに対してVBAで用意されているイベント処理が適用されるのです。ソースコードでは以下の部分です。
Private Sub myLbl_Click()
Call openLbl(myLbl)
End Sub
私もうまく説明できないので最初に示したリンクを参照されると良いと思います。
マスをクリックしたときの処理
さて、このプログラムで一番厄介なところです。マスをクリックしたらそのマスを開き、もし地雷だったらゲームオーバー、数字だったらマスに数字を記入、もし空欄だったら数字を開くまで隣のマスを探索し続けます。
この中で一番難しいのは、「クリックしたら空欄である限りその隣も開き続ける」という処理です。これは、openLblというプロシージャを一定の条件（＝数字が書いてあるマスを開くこと、また開いたマスが端のマスであること）まで再帰処理させることで実現します。
加えて、全方位に調べるということなので、openLblプロシージャ内に、左上、上、右上、左、右、左下、下、右下の8種類のCall OpenLbl()があり、その引数にはそれぞれが向かう方向のラベルオブジェクトを取ります。
一例として、今クリックしたラベルの番号を仮に変数nとおくと、例えば左上への探索だったらCall openLbl(form.Controls("L" & n- 10))という感じですね。
マスを開き続ける再帰処理をどう止めるか
例えばマスをクリックしてどんどん開き続けたとき、もし左上方向への再帰処理であれば、上端のマス（＝L1、L2、L3、L4、L5、L6、L7、L8）を開かれたら処理を止める必要があります。もちろん、8方向それぞれに対して止めるトリガーとなる終端のマスは異なります。そこで、私はarr()という配列変数を8個作り、それぞれの方向への再帰処理を止めるマス番号を格納しました。
要するに、左上方向への再帰処理は、arr(0)内のいずれかのマスに来たら処理終了、上方向への再帰処理はarr(1)内のいずれかのマスに来たら終了、というやり方です。
右クリックで旗を置く
マインスイーパには右クリックで目印の旗を置く機能があります。旗の絵を置くのが面倒なので、？のマークを置くことにしました。最初このマインスイーパを作ったとき、VBAでフォーム上で右クリックイベントができることを知らなかったので、この機能はつけていませんでしたが、調べてみたら方法があるらしいので最近実装しました。
それがソースコード内でいう、myLbl_MouseDownのイベントプロシージャです。ほぼコピペベースでやったので詳しいことはわかりませんが、どうやらButtonという引数にクリックされたボタンが渡されるらしいです。ちなみに右クリックするとButtonには2の数字が渡されます。それ以外の引数についてはよくわかりません。
そんな感じでなんとかでき上がりました。以下プレイ動画です（私は全然うまくないので、結構時間かかっています・・・）
ソースコード
以下、ソースコードです。
'-----------------------------------------------------------------------' ' 標準モジュール '-----------------------------------------------------------------------' Public lightColor As Variant Public darkColor As Variant Public blackColor As Variant Public status(1 To 81) As Integer '//ラベルの状態：0=数字なし、1=数字あり、2＝地雷あり Public LNum(1 To 81) As Integer '//各81枚のラベルに記載する数字を格納 Public lblCount As Integer Public lblArray(1 To 81) As New class1 Public gameOverFlg As Boolean Sub startGame() form.Show End Sub '-----------------------------------------------------------------------' ' ユーザーフォーム '-----------------------------------------------------------------------' Private Sub UserForm_Initialize() Dim i As Integer, j As Integer gameOverFlg = False lightColor = RGB(200, 200, 200) darkColor = RGB(160, 160, 160) blackColor = RGB(0, 0, 0) lblCount = 0 For i = 1 To 81 With form.Controls("L" & i) .ForeColor = darkColor .BackColor = darkColor .Caption = "" End With status(i) = 0 LNum(i) = 0 lblArray(i).lblSet Controls("L" & i) Next i Call mineSet '//爆弾をセットする Call numberSet '//数字をセットする End Sub Private Sub CommandButton1_Click() UserForm_Initialize End Sub Private Sub mineSet() '//ラベルに地雷をセット Dim cnt As Integer Dim num As Long cnt = 0 Randomize Do Do num = Int(Rnd * 81) + 1 If status(num) <> 2 Then status(num) = 2 cnt = cnt + 1 If cnt = 10 Then Exit Sub Exit Do End If Loop Loop End Sub Sub numberSet() Dim i As Integer, j As Integer Dim arr As Variant Dim arrLength As Integer Dim mineCnt As Integer For i = 1 To 81 mineCnt = 0 Select Case i Case 1, 9, 73, 81 Select Case i Case 1 arr = Array(2, 10, 11) Case 9 arr = Array(8, 17, 18) Case 73 arr = Array(64, 65, 74) Case 81 arr = Array(71, 72, 80) End Select Case 2 To 8 arr = Array(i - 1, i + 1, i + 8, i + 9, i + 10) Case 74 To 80 arr = Array(i - 10, i - 9, i - 8, i - 1, i + 1) Case 10, 19, 28, 37, 46, 55, 64 arr = Array(i - 9, i - 8, i + 1, i + 9, i + 10) Case 18, 27, 36, 45, 54, 63, 72 arr = Array(i - 10, i - 9, i - 1, i + 8, i + 9) Case Else arr = Array(i - 10, i - 9, i - 8, i - 1, i + 1, i + 8, i + 9, i + 10) End Select arrLength = UBound(arr) '//1マスごとに周囲にいくつ地雷があるかを数える For j = 0 To arrLength If status(arr(j)) = 2 Then mineCnt = mineCnt + 1 End If Next j '//地雷の数が1以上ならマスに記入 If mineCnt > 0 And status(i) <> 2 Then status(i) = 1 LNum(i) = mineCnt End If Next i End Sub '-----------------------------------------------------------------------' ' クラスモジュール '-----------------------------------------------------------------------' Private WithEvents myLbl As MSForms.Label Public Sub lblSet(ByVal obj As MSForms.Label) Set myLbl = obj End Sub Private Sub myLbl_Click() Call openLbl(myLbl) End Sub Private Sub myLbl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) If Not myLbl.BackColor = darkColor Then Exit Sub If Button = 2 Then If myLbl.Caption = "" Then myLbl.Caption = "？" Else myLbl.Caption = "" End If myLbl.ForeColor = blackColor End If End Sub Private Sub openLbl(clickedLbl As MSForms.Label) Dim x As Integer Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, o As Integer, p As Integer, q As Integer Dim lblNum As Integer Dim arr(7) As Variant Dim stopFlg(7) As Boolean Dim opendLblNum As Integer '//クリックしたラベルの番号だけを取得 lblNum = Mid(clickedLbl.Name, 2, Len(clickedLbl.Name) - 1) '//ラベルを開く再帰処理を止めるフラグを初期化 For x = 0 To 7 stopFlg(x) = False Next x '//ラベルを開く再帰処理を止めるための条件 arr(0) = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 19, 28, 37, 46, 55, 64, 73) '左上 arr(1) = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) '上 arr(2) = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 18, 27, 36, 45, 54, 63, 72, 81) '右上 arr(3) = Array(1, 10, 19, 28, 37, 46, 55, 64, 73) '左 arr(4) = Array(9, 18, 27, 36, 45, 54, 63, 72, 81) '右 arr(5) = Array(1, 10, 19, 28, 37, 46, 55, 64, 73, 74, 75, 76, 77, 78, 79, 80, 81) '左下 arr(6) = Array(73, 74, 75, 76, 77, 78, 79, 80, 81) '下 arr(7) = Array(9, 18, 27, 36, 45, 54, 63, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81) '右下 If clickedLbl.BackColor = lightColor Or gameOverFlg = True Then '//すでにラベルが開いているかゲームオーバーになってる場合は何もしない Exit Sub Else '//ラベルを開く（=色を変える） clickedLbl.BackColor = lightColor If LNum(lblNum) <> 0 Then clickedLbl.Caption = LNum(lblNum) If clickedLbl.Caption = "？" Then clickedLbl.Caption = "" Call checkGameOver(lblNum) openedLblNum = countLbl End If '//ラベルの数字によって文字の色を変える（本当は8まで必要だが・・・） Select Case clickedLbl.Caption Case 1 clickedLbl.ForeColor = RGB(11, 49, 143) Case 2 clickedLbl.ForeColor = RGB(230, 0, 18) Case 3 clickedLbl.ForeColor = RGB(0, 154, 62) Case 4 clickedLbl.ForeColor = RGB(4, 29, 90) Case 5 clickedLbl.ForeColor = RGB(153, 0, 0) End Select '/* 以下、ラベルをクリックしたときそれが空欄である '/ （statusが0)限り隣のラベルを開き続ける再帰処理 */ If status(lblNum) = 0 Then '//左上 For i = 0 To UBound(arr(0)) If lblNum = arr(0)(i) Then stopFlg(0) = True Exit For End If Next i If stopFlg(0) = False Then Call openLbl(form.Controls("L" & lblNum - 10)) '//上 For j = 0 To UBound(arr(1)) If lblNum = arr(1)(j) Then stopFlg(1) = True Exit For End If Next j If stopFlg(1) = False Then Call openLbl(form.Controls("L" & lblNum - 9)) '//右上 For k = 0 To UBound(arr(2)) If lblNum = arr(2)(k) Then stopFlg(2) = True Exit For End If Next k If stopFlg(2) = False Then Call openLbl(form.Controls("L" & lblNum - 8)) '//左 For l = 0 To UBound(arr(3)) If lblNum = arr(3)(l) Then stopFlg(3) = True Exit For End If Next l If stopFlg(3) = False Then Call openLbl(form.Controls("L" & lblNum - 1)) '//右 For m = 0 To UBound(arr(4)) If lblNum = arr(4)(m) Then stopFlg(4) = True Exit For End If Next m If stopFlg(4) = False Then Call openLbl(form.Controls("L" & lblNum + 1)) '//左下 For o = 0 To UBound(arr(5)) If lblNum = arr(5)(o) Then stopFlg(5) = True Exit For End If Next o If stopFlg(5) = False Then Call openLbl(form.Controls("L" & lblNum + 8)) '//下 For p = 0 To UBound(arr(6)) If lblNum = arr(6)(p) Then stopFlg(6) = True Exit For End If Next p If stopFlg(6) = False Then Call openLbl(form.Controls("L" & lblNum + 9)) '//右下 For q = 0 To UBound(arr(7)) If lblNum = arr(7)(q) Then stopFlg(7) = True Exit For End If Next q If stopFlg(7) = False Then Call openLbl(form.Controls("L" & lblNum + 10)) End If If openedLblNum = 71 Then MsgBox "GAME CLEAR!!" gameOverFlg = True End If End Sub Private Sub checkGameOver(ByVal n As Integer) '地雷を開いてしまったときの挙動 Dim i As Integer If status(n) = 2 Then gameOverFlg = True If gameOverFlg = True Then For i = 1 To 81 With form.Controls("L" & i) .ForeColor = blackColor If status(i) = 2 Then .Caption = "＊" .BackColor = RGB(255, 0, 0) Else If status(i) = 1 Then .Caption = LNum(i) End If .BackColor = lightColor End If End With Next i End If End Sub Function countLbl() As Integer lblCount = lblCount + 1 countLbl = lblCount End Function
