トップ > 逆引きで学ぶ ユーザーフォーム&コントロール > 追加章　遊ぶ！楽しむ！ユーザーフォーム > T-10　ユーザーフォームで「三択クイズ」を作る！

Option Explicit
'【定数】
Private Const NOQ As Long = 10        '出題数（Number of questions）
Private Const SHN As String = "quiz1" '出題対象シート名

'【変数】
Private lngQCT        As Long   '出題回数：その時点の出題番号
Private lngSelN       As Long   '選択番号：選択した回答番号（1～3）
Private lngOrder()    As Long   '出題問題行番号格納
Private strQuestion() As String '出題内容　　　記録用
Private strCorrectA() As String '正解テキスト　記録用
Private strCorIncor() As String '各回答○×　　記録用
Private lngCrtACnt    As Long   '正解回数
Private sinTime       As Single '開始時間格納

'■フォームイベント
'+++ Initializeイベント +++
Private Sub UserForm_Initialize()
    Dim c          As Long      '
    Dim lngRnd     As Long      'ランダム整数値格納
    Dim lngLastRow As Long      'データの最終行格納
    Dim strMsg     As String    'メッセージ用
    
    '出題データの最終行取得
    lngLastRow = Worksheets(SHN).Cells(Rows.Count, "B").End(xlUp).Row
    
    'エラーチェック
    If lngLastRow = 1 Then strMsg = "問題が入力されていません": GoTo FIN
    If NOQ < 1 Or (lngLastRow - 1) < NOQ Then
        strMsg = "NOQ数が適切ではありません": GoTo FIN
    End If
    
    '重複のない問題番号をランダムに抽出し行番号としてlngOrderに代入（出題数分）
    Randomize
    ReDim f(1 To (lngLastRow - 1)) As Boolean
    ReDim lngOrder(1 To NOQ)
    Do
        lngRnd = Int(Rnd() * (lngLastRow - 1)) + 1
        If Not f(lngRnd) Then
            f(lngRnd) = True
            c = c + 1
            lngOrder(c) = lngRnd + 1 'データの1行目は見出しのため「1」加算
        End If
    Loop Until NOQ <= c
    
    '選択番号初期設定/出題回数初期設定
    lngSelN = 1
    lngQCT = 1
    
    '最初のクイズを出題
    Call Set_Quiz
    
    '開始時間格納
    sinTime = Timer
    Exit Sub
FIN:
    MsgBox strMsg, vbExclamation, "終了します"
    Unload Me
End Sub

'+++ KeyDownイベント +++
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                             ByVal Shift As Integer)
    Select Case KeyCode
        Case vbKeyUp     '方向キー上（↑） 整数値：38
            lngSelN = lngSelN - 1
            If lngSelN = 0 Then lngSelN = 3
        Case vbKeyDown   '方向キー下（↓） 整数値：40
            lngSelN = lngSelN + 1
            If lngSelN = 4 Then lngSelN = 1
        Case vbKeyEscape 'Escキー　　　　　整数値：27
            Unload Me
        Case vbKeyReturn 'Enterキー　　　　整数値：13
            '選んだ回答番号のラベルCaptionが正解テキスト同じ場合は正解数を加算
            If Controls("Label_A" & lngSelN).Caption = strCorrectA(lngQCT) Then
                lngCrtACnt = lngCrtACnt + 1
                strCorIncor(lngQCT) = "○"
            Else
                strCorIncor(lngQCT) = "×"
            End If
            If lngQCT = NOQ Then GoTo FIN '出題回数が出題数と同じになったら終了
            lngQCT = lngQCT + 1
            Call Set_Quiz                 '次のクイズを出題
            Exit Sub
        Case Else
            Exit Sub
    End Select
    Call Set_BackColor(lngSelN)           '回答ラベルの背景色を設定
    Exit Sub
FIN: '--- 終了メッセージ作成 ---
    Dim i      As Long
    Dim strMsg As String
    For i = 1 To lngQCT '出題内容・正解・○×の各配列の値をつなげる
        strMsg = strMsg & "[" & i & "] " & strCorIncor(i) & " / "
        strMsg = strMsg & strQuestion(i) & " / " & strCorrectA(i) & vbLf
    Next
    MsgBox "正解数：" & lngCrtACnt & "/" & NOQ & "　" & _
           "正解率：" & Application.Round(lngCrtACnt / NOQ, 1) * 100 & "%　" & _
           "所用時間：" & Application.Round(Timer - sinTime, 1) & "秒" & vbLf & _
           vbLf & strMsg
    Unload Me
End Sub

'■サブルーチン
'+++ 回答ラベルの背景色を設定 +++
'【引数】
'   n：背景色を白くするラベル番号
'++++++++++++++++++++++++++++++++
Private Sub Set_BackColor(ByVal n As Long)
    Dim i As Long
    For i = 1 To 3
        Controls("Label_A" & i).BackColor = &H8000000F
    Next
    Controls("Label_A" & n).BackColor = &HFFFFFF
End Sub

'+++ クイズ出題 +++
Private Sub Set_Quiz()
    Dim varPattern As Variant '回答表示順パターン
    Dim varSplit   As Variant '
    '回答表示順パターン格納
    varPattern = Array("1,2,3", "1,3,2", "2,1,3", "2,3,1", "3,1,2", "3,2,1")
    'パターンをランダムに取得し分割
    varSplit = Split(varPattern(Int(Rnd() * 6)), ",") '【例】[2,1,3]→[2]/[1]/[3]
    
    '配列拡張
    ReDim Preserve strQuestion(1 To lngQCT) '出題内容
    ReDim Preserve strCorrectA(1 To lngQCT) '正解
    ReDim Preserve strCorIncor(1 To lngQCT) '○×
    
    'ラベルと配列に値を設定
    Dim r As Long: r = lngOrder(lngQCT)
    With Worksheets(SHN)
        Label_Q.Caption = "[" & lngQCT & "] " & .Cells(r, "B")
        Label_A1.Caption = .Cells(r, 2 + Val(varSplit(0)))
        Label_A2.Caption = .Cells(r, 2 + Val(varSplit(1)))
        Label_A3.Caption = .Cells(r, 2 + Val(varSplit(2)))
        strQuestion(lngQCT) = .Cells(r, "B")
        strCorrectA(lngQCT) = .Cells(r, "C")
    End With
    'Beep '音を鳴らす場合はコメントを外す
End Sub

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

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

■ 購入：amazon