トップ > 逆引きで学ぶ ユーザーフォーム&コントロール > 追加章　遊ぶ！楽しむ！ユーザーフォーム > T-09　数当てゲーム「ヒット・アンド・ブロー」を作る！

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

'定数
Private Const FCW As Single = 30 'フォーム上のセル幅
Private Const FCH As Single = 30 'フォーム上のセル高さ
Private Const FCN As String = "FCells_" 'フォーム上のセルのベース名

'変数
Private strNumber  As String '4桁ランダム数値
Private sinTimer   As Single '開始時間格納用
Private lngInputC  As Long   '入力回数
Private strAddress As String '色変更セルアドレス

'■ラベルイベント(Label_Main)
'+++ Clickイベント +++
Private Sub Label_Main_Click()
    If strAddress = "" Then Exit Sub
    Dim strValue As String
    strValue = Controls(strAddress).Caption
    With Controls("Number" & lngInputC)
        If Left$(strValue, 1) = "C" Then              'クリア
            .Caption = ""
        ElseIf Left$(strValue, 1) = "B" Then          'バックスペース
            If .Caption = "" Then Exit Sub
            .Caption = Left$(.Caption, Len(.Caption) - 1)
        Else
            If Len(.Caption) = 4 Then Exit Sub       '4つ以上の入力回避
            If 0 < InStr(1, .Caption, strValue) Then '同じ数字チェック
                MsgBox "同じ数字は2回使用できません", vbInformation
                Exit Sub
            End If
            .Caption = .Caption & strValue
        End If
    End With
End Sub

'+++ MouseMoveイベント +++
Private Sub Label_Main_MouseMove(ByVal Button As Integer, _
                                 ByVal Shift As Integer, _
                                 ByVal X As Single, _
                                 ByVal Y As Single)
    
    If strAddress <> "" Then Controls(strAddress).BackColor = &HFFFFFF
    
    Dim strRow    As String
    Dim strColumn As String
    
    strRow = CStr((Y \ FCH) + 1)    'マウス位置よりフォームセルの行を取得
    strColumn = CStr((X \ FCW) + 1) 'マウス位置よりフォームセルの列を取得
    strAddress = FCN & strRow & "_" & strColumn
    Controls(strAddress).BackColor = &HC0FFFF 'セルの色を変更
End Sub

'■フォームイベント(UserForm)
'+++ Initializeイベント +++
Private Sub UserForm_Initialize()
    Dim c       As Long
    Dim n       As Long
    Dim bolN(9) As Boolean
    Randomize
    Do '重複のないランダムな4桁を生成
        n = Int(Rnd() * 10)
        If Not bolN(n) Then
            bolN(n) = True
            strNumber = strNumber & CStr(n)
            c = c + 1
            If c = 4 Then Exit Do
        End If
    Loop
    sinTimer = Timer '開始時間格納
End Sub

'+++ MouseMoveイベント +++
Private Sub UserForm_MouseMove(ByVal Button As Integer, _
                               ByVal Shift As Integer, _
                               ByVal X As Single, _
                               ByVal Y As Single)
    If strAddress <> "" Then
        Controls(strAddress).BackColor = &HFFFFFF
        strAddress = ""
    End If
End Sub

'■コマンドボタンイベント(CommandButton1)
'+++ Clickイベント +++
Private Sub CommandButton1_Click()
    With Controls("Number" & lngInputC)
        If Len(.Caption) <> 4 Then
            MsgBox "数字を4つ選択してください", vbInformation: Exit Sub
        End If
        .BackColor = &H8000000F
        If .Caption = strNumber Then '正解
            Dim strTime As String
            strTime = CStr(Int((Timer - sinTimer) * 100) / 100)
            MsgBox "おめでとう！！" & vbLf & "所用時間：" & strTime & "秒", _
                vbInformation, "正解"
            GoTo FIN
        End If
        Controls("Result" & lngInputC).Caption = Hit_Blow(strNumber, .Caption)
    End With
    lngInputC = lngInputC + 1
    If lngInputC = 10 Then
        MsgBox "残念・・・" & vbLf & "正解は" & strNumber, vbExclamation, "OUT"
        GoTo FIN
    End If
    Controls("Number" & lngInputC).BackColor = &HC0FFFF
    Exit Sub
FIN:
    Unload Me
End Sub

'■関数
'+++ hit-blow関数 +++++++++++
'hitとblowを文字列で返す
'【引数】
'   n1：比較元ナンバー
'   n2：ユーザー入力ナンバー
'++++++++++++++++++++++++++++
Private Function Hit_Blow(ByVal n1 As String, ByVal n2 As String) As String
    Dim i       As Long
    Dim lngHit  As Long
    Dim lngBlow As Long
    For i = 1 To Len(n2)
        If InStr(1, n1, Mid$(n2, i, 1)) = i Then '桁の位置・数字ともに同じ
            lngHit = lngHit + 1
        ElseIf 0 < InStr(1, n1, Mid$(n2, i, 1)) Then '数字は含まれる
            lngBlow = lngBlow + 1
        End If
    Next
    Hit_Blow = CStr(lngHit) & "-" & CStr(lngBlow)
End Function

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

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

■ 購入：amazon