トップ > 逆引きで学ぶ ユーザーフォーム&コントロール > 追加章 遊ぶ!楽しむ!ユーザーフォーム > T-08 ユーザーフォームでマインスイーパーを作る!

T-08 ユーザーフォームでマインスイーパーを作る!2022.05.06

次の書籍の第1章~5章を公開しています。
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」

目次  前頁   次頁  索引

今回は、ユーザーフォームでマインスイーパーを作ります。
Wikipedia:マインスイーパー

マインスイーパーは、ユーザーがボタンをクリックした動作に伴い、処理を実行する仕組みのため、フォームのイベントと親和性が高く、フォームで作りやすいゲームの代表格です。

次図は、フォームで作成したマインスイーパーのサンプルです。


【動画】


このような動作の実現にはいくつかの方法が考えられますが、最も簡単だと思われる方法で実装します。

サンプルファイル ダウンロード


準備 1

ユーザーフォームを挿入し、次のコントロールを追加します。

■Labelコントロール
 役割:疑似セル 数値の表示等
 オブジェクト名:FCells_(行番号)_(列番号)
 個数:81
 幅:18(ポイント)
 高さ:18(ポイント)
 BackColor:&H00E0E0E0&
 BackStyle:1 - fmBackStyleOpaque
 BorderStyle:0 - fmBorderStyleNone
 Font:スタイル 太字 サイズ 14
 ForeColor:&H80000012&
 SpecialEffect:1 - fmSpecialEffectRaised
 TextAlign:2 - fmTextAlignCenter


■Labelコントロール
 役割:イベント感知用
 オブジェクト名:Label_Main
 個数:1
 幅:162
 高さ:162
 BackStyle:0 - fmBackStyleTransparent
 BorderStyle:0 - fmBorderStyleNone


準備 2

格子状に配置したLabelコントロールにオブジェクト名を設定します。
後の処理がしやすいように、名前に行列番号を入れておきます。
※マクロでまとめてオブジェクト名を設定する方法はこちらをご覧ください
【例】FCells_2_3 共通ベース名:「FCells_」 行番号:2 列番号:3


イベント感知用のLabelを、格子状のLabelコントロールにぴったりとかぶせるような形で配置します。


イベント感知用のLabelコントロールを一番手前にします。
感知用Labelが一番手前でない場合は、感知用Labelを選択した状態で、メニューバーの「書式」→「順序」→「最前面へ移動」を選択します。


サンプルコード

フォームモジュールに記述します。

'フォーム上にセルに見立てたラベルを格子状に配置しています
'そのラベル群を便宜上フォームのセルと呼びます
Option Explicit

'定数
Private Const FCW As Single = 18        'フォーム上のセル幅
Private Const FCH As Single = 18        'フォーム上のセル高さ
Private Const FCN As String = "FCells_" 'フォーム上のセルのベース名
Private Const BCT As Long = 10          '地雷個数 適正範囲:5~20程度

'変数
Private lngCellsData(1 To 9, 1 To 9) As Long 'フォームセルに対応させる2次元配列
Private lngBlankNumber As Long               '空白ナンバー格納用
Private sinTimer       As Single             '開始時間格納用

'■ラベルイベント(Label_Main) '+++ MouseDownイベント +++ Private Sub Label_Main_MouseDown(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) Dim lngR As Long: lngR = (Y \ FCH) + 1 'マウスポインタ垂直位置から行取得 Dim lngC As Long: lngC = (X \ FCW) + 1 'マウスポインタ垂直位置から列取得 Dim strTargetName As String: strTargetName = FCN & lngR & "_" & lngC 'フォームセルのSpecialEffectが「1 - fmSpecialEffectRaised」(凸)以外の場合は抜ける If Controls(strTargetName).SpecialEffect <> 1 Then Exit Sub With Controls(strTargetName) If Button = 1 Then '--- マウス左ボタン --- Dim lngValue As Long: lngValue = lngCellsData(lngR, lngC) Select Case lngValue Case -1 MsgBox "地雷・・・", vbExclamation, "OUT:終了します": Unload Me Case 1 To 8 Call DisplayOfNumbers(lngR, lngC, lngValue) '数値表示処理 Case Is > 100 Call Set_Sunken(lngValue) '数値に対応した空白セルを凹に設定 End Select If BCT = Count_Raised() Then '地雷数と凸セル数が同じであればクリア Dim strTime As String strTime = CStr(Int((Timer - sinTimer) * 100) / 100) MsgBox "おめでとう!!" & vbLf & "所用時間:" & strTime & "秒", _ vbInformation, "クリア" Unload Me End If ElseIf Button = 2 Then '--- マウス右ボタン --- If .Caption = "▲" Then .Caption = "" .BackColor = &H8000000F Else .Caption = "▲" .BackColor = &HFF& End If End If End With End Sub
'■フォームイベント(UserForm) '+++ Initializeイベント +++ Private Sub UserForm_Initialize() If BCT < 1 Or 80 < BCT Then MsgBox "BCTの値が適切ではありません", vbExclamation, "終了します" Unload Me End If Call Init_Bomb '地雷配置 Call Set_Number '数値設定 Call Set_Blank '空白設定 sinTimer = Timer '開始時間格納 Me.Caption = "Exマインスイーパー 地雷数:" & BCT End Sub
'■サブルーチン・関数 '+++ 2次元配列のランダムな箇所に地雷配置 +++ Private Sub Init_Bomb() Dim lngR As Long Dim lngC As Long Dim c As Long Erase lngCellsData Randomize Do lngR = Int(Rnd() * 9) + 1 lngC = Int(Rnd() * 9) + 1 If lngCellsData(lngR, lngC) = 0 Then c = c + 1 lngCellsData(lngR, lngC) = -1 '地雷:-1 End If Loop Until c = BCT End Sub
'+++ 2次元配列で0の箇所は周囲の地雷数をカウントし設定 +++ Private Sub Set_Number() Dim i As Long, j As Long For i = 1 To 9 For j = 1 To 9 If lngCellsData(i, j) = 0 Then lngCellsData(i, j) = Count_Bomb(i, j) End If Next Next End Sub
'+++ 2次元配列で周囲の地雷数をカウントする関数 +++ Private Function Count_Bomb(ByVal lngR As Long, ByVal lngC As Long) As Long Dim i As Long, j As Long For i = lngR - 1 To lngR + 1 For j = lngC - 1 To lngC + 1 If (0 < i And i < 10) And (0 < j And j < 10) Then If lngCellsData(i, j) = -1 Then Count_Bomb = Count_Bomb + 1 End If Next Next End Function
'+++ 2次元配列で0の場合に空白ナンバーを設定 +++ Private Sub Set_Blank() Dim i As Long, j As Long lngBlankNumber = 100 For i = 1 To 9 For j = 1 To 9 If lngCellsData(i, j) = 0 Then lngBlankNumber = lngBlankNumber + 1 lngCellsData(i, j) = lngBlankNumber Call Blank_Number(i, j) '2次元配列上下左右の値を確認 End If Next Next End Sub
'+++ 2次元配列で上下左右に0があった場合自身の空白ナンバーをコピー +++ Private Sub Blank_Number(ByVal lngR As Long, ByVal lngC As Long) Dim i As Long, j As Long For i = lngR - 1 To lngR + 1 Step 2 If (0 < i And i < 10) Then If lngCellsData(i, lngC) = 0 Then lngCellsData(i, lngC) = lngCellsData(lngR, lngC) Call Blank_Number(i, lngC) '再帰 End If End If Next For j = lngC - 1 To lngC + 1 Step 2 If (0 < j And j < 10) Then If lngCellsData(lngR, j) = 0 Then lngCellsData(lngR, j) = lngCellsData(lngR, lngC) Call Blank_Number(lngR, j) '再帰 End If End If Next End Sub
'+++ フォームセルの数値表示処理 +++ Private Sub DisplayOfNumbers(lngR As Long, lngC As Long, lngValue As Long) With Controls(FCN & lngR & "_" & lngC) .SpecialEffect = 2 'fmSpecialEffectSunken(凹)に設定 .BackColor = &H8000000F .Caption = CStr(lngValue) .ForeColor = Cells(lngValue, "A").Interior.Color '文字色 End With End Sub
'+++ 2次元配列内の数値(n)に対応するフォームセルのエフェクトをSunkenに設定 +++ Private Sub Set_Sunken(ByVal n As Long) Dim i As Long, j As Long For i = 1 To 9 For j = 1 To 9 If lngCellsData(i, j) = n Then Controls(FCN & i & "_" & j).SpecialEffect = 2 Controls(FCN & i & "_" & j).BackColor = &H8000000F Call Target_Check(i, j) End If Next Next End Sub
'+++ 空白凹表示セルに隣接する数値非表示セルの表示処理 +++ Private Sub Target_Check(ByVal lngR As Long, ByVal lngC As Long) Dim i As Long, j As Long, n As Long For i = lngR - 1 To lngR + 1 For j = lngC - 1 To lngC + 1 If (0 < i And i < 10) And (0 < j And j < 10) Then n = lngCellsData(i, j) If Controls(FCN & i & "_" & j).SpecialEffect = 1 And n < 100 Then Call DisplayOfNumbers(i, j, n) End If End If Next Next End Sub
'+++ SpecialEffectがRaised(凸)のフォームセルをカウントする関数 +++ Private Function Count_Raised() As Long Dim i As Long, j As Long For i = 1 To 9 For j = 1 To 9 If Controls(FCN & i & "_" & j).SpecialEffect = 1 Then Count_Raised = Count_Raised + 1 End If Next Next End Function

簡単な解説

■フォーム構成
フォームで使用しているコントロールは全てLabelコントロールです。
格子状に配置した81個のLabelと、イベント感知用のLabelになります。
イベント感知用のLabelは重なり順を一番手前にし、格子状のラベルにぴったりと重ねています。

■イベント
今回利用しているイベントは次の2つです。
・フォームのInitializeイベント
・LabelコントロールのMouseDownイベント
Initializeイベントでデータを設定し、MouseDownイベントでユーザーのマウス操作を受け取っています。

■Initializeイベントでのデータ設定
Initializeイベントでは、フォームセルに対応させる9×9の2次元配列(lngCellsData)にデータを設定しています。
設定するデータは次の通りです。
-1:地雷・・・サブルーチンInit_Bomb()
1~8:周囲の地雷の数・・・サブルーチンSet_Number()
100超過:単一あるいは連続した空白地・・・サブルーチンSet_Blank()

Initializeイベント後のlngCellsData変数内のイメージ


Init_Bomb()は、行列をランダムで取得し、2次元配列の該当箇所が0の場合に-1を代入します。-1は地雷を表します。
その処理をBCTに設定した数値の回数繰り返します。


Set_Number()は、2次元配列で自身の周囲にあたる箇所の地雷数をカウントし設定します。


Set_Blank()は、単一または連続した空白箇所を探索し、該当箇所にlngBlankNumberの値を代入します。lngBlankNumberは100から始まり、新たに探索を開始する度に1が加算されます。


■MouseDownイベントの処理
LabelコントロールのMouseDownイベントは、ラベル上のマウスポインタの垂直位置(Y)と水平位置(X)を取得できます。
その値から、フォームセルの行列を算出しています。
該当フォームセルのSpecialEffectを確認し、設定値が「1」(ボタン凸状態)の場合にのみ処理を続行します。

【マウス左ボタン】
フォームセルの行列に該当する2次元配列から値を取得し、その値をもとに処理の分岐を行っています。
-1:地雷のため終了
1~8:数値を表示
   SpecialEffectを「2」(ボタン凹状態)に設定
   背景色変更
   フォントカラー設定 ワークシートのセル[A1:A8]の背景色を参照
100超過:同じ数値を2次元配列内で検索し、見つかった箇所に対応する
   フォームセルのSpecialEffectを「2」(ボタン凹状態)に設定
   あわせて隣接する数値が非表示のフォームセルに数値表示処理を実行

フォームセルのSpecialEffectが「1」のものをカウントし、地雷の個数と同じになればクリア!

【マウス右ボタン】
該当フォームセルのCaptionの値を確認します。
・空白:「▲」を設定し、背景色を赤に設定。
・「▲」:「空白」を設定し、背景色をグレーに設定


書籍紹介140以上のサンプルファイル付き!

知りたいがすぐわかる! やりたいがすぐできる!
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」(Kindle版)
ユーザーフォームを扱えると、VBAでできることが大きく広がります!
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。

■ 購入:amazon

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.