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は重なり順を一番手前にし、格子状のラベルにぴったりと重ねています。

■イベント
今回利用しているイベントは次の２つです。
・フォームの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」（ボタン凹状態）に設定
　　　あわせて2次元配列で隣接する要素の数値が1～8の場合は、
　　　その箇所に対応するフォームセルをボタン凹状態にして、数値を表示する

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

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

　・T-09　数当てゲーム「ヒット・アンド・ブロー」を作る！
　・T-07　マウスポインタ下のイメージを自動で移動させる
　・追加章　遊ぶ！楽しむ！ユーザーフォーム
　・目次
　・索引

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

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

■ 購入：amazon

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