【Excel VBA】四択クイズのプログラムで次の問題に進めない

実現したいこと

たたき台として、以下のサイトに記載のVBAコードで、四択問題を出し、正誤の結果を記録するプログラムを作成します。

試験勉強に最適な「Excel 4択クイズ実行プログラム」

前提

プログラムの概要は以下の通りです。

Sheet1に問題と選択肢を（必要であれば解説も）入力する。（A列：問題番号、B列：問題文、C列：選択肢（正答）、D~F列：選択肢（誤答）、G列：解説文
Sheet2のボタンを押してプログラムを実行するとフォームが表示される。
「スタート」をクリックする。
入力した問題がランダムに実行される。選択肢の位置もランダム表示される。
4つの選択肢ボタンを押して答えを選ぶ。
正答か誤答かフィードバックされる。（入力していれば、解説も表示される）
次の問題に進むかどうか聞かれる。
「はい」→④に戻り、くり返す。「いいえ」→出題を終了する。
日付、正答率、問題番号と正誤を記録する。Sheet3の「データ処理」ボタンを押すと問題番号順に正誤の結果が並び替えられる。重複データは削除され、正答と誤答どちらを優先するかも変更できる。

作成したフォームは下の画像のようにします。

オレンジは、各要素のオブジェクト名や大きさ等を示しています。このオブジェクトを元にコードを入力します。

該当のソースコード

フォーム内に記載したコードは以下の通りです。

VBA
1Option Explicit
2Dim CorrectAns, CmntRow
3
4Private Sub UserForm_Initialize()
5   info.Visible = False
6End Sub
7
8Private Sub ToggleButton5_Click()
9    setQuizData
10    
11'保存用シートへのデータ貼りつけ用の最終列取得の次の列i
12    Dim i
13    i = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column
14    If Sheet3.Cells(1, i).Value <> "" Then i = i + 1 'A1が空白ならiを1とする
15    
16'記録用シートに日付を入力する
17Sheet2.Range("A1").Value = Date
18Sheet2.Range("B1").Value = "％" '後に正答率を入力する
19    
20Do
21    While info.Visible = False
22        DoEvents
23    Wend
24    
25    Dim nextQuiz
26    nextQuiz = MsgBox("次の問題に進みますか？", vbInformation + vbYesNo)
27    If nextQuiz = vbYes Then
28        info.Visible = False
29        setQuizData
30    Else
31        Exit Do
32    End If
33        
34    Loop
35    Sheet2.Range("A1").CurrentRegion.Copy 'Sheet2のデータをコピー
36    'Sheet3に貼りつけ
37    Sheet3.Cells(1, i).PasteSpecial Paste:=xlPasteValues, _
38    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
39    Sheet3.Cells(1, i).NumberFormatLocal = "mm/dd" '表示形式を00月00日へ
40    Sheet3.Cells(1, i + 1).NumberFormatLocal = "0%" '表示形式をパーセントへ
41    Sheet2.Cells.Clear '記録用シートの初期化
42
43    Call getAverage(i)
44    
45    MsgBox "問題集を終了します", vbInformation + vbOKOnly
46    Unload Me
47End Sub
48
49Private Sub getAverage(ByVal lBeginCol As Long)
50
51    Const TARGET_SHEET_NAME As String = "Sheet3"
52    Const COL_OFFSET        As Long = 2
53    Dim sHeader     As String
54    Dim lCol        As Long
55    Dim lEndRow     As Long
56    Dim lTargetCol  As Long
57
58    lCol = lBeginCol
59
60    With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
61        sHeader = .Cells(1, lCol).Value
62
63        Do Until sHeader = ""
64            lEndRow = .Cells(1, lCol).End(xlDown).Row
65
66            lTargetCol = lCol + 1
67
68            .Cells(1, lTargetCol).Value = WorksheetFunction.Average(.Range(.Cells(2, lTargetCol), .Cells(lEndRow, lTargetCol)))
69
70            lCol = lCol + COL_OFFSET
71
72            sHeader = .Cells(1, lCol).Value
73        Loop
74    End With
75End Sub
76
77Private Sub setQuizData()
78    
79    Randomize '乱数ジェネレータを初期化    
80    Dim rowNo
81    rowNo = Int(Rnd * Sheet1.UsedRange.Rows.Count + 1)
82    quizText.Text = Sheet1.Cells(rowNo, 2)
83    CmntText.Text = ""
84    
85'rowNoは問題の行数    
86'解説を表示するためにrowNoを記録しておく
87    CmntRow = rowNo
88        
89'問題ナンバーを入力する行番号mを定義
90Dim m
91    m = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1    
92    ans1.Value = False
93    ans2.Value = False
94    ans3.Value = False
95    ans4.Value = False
96    
97    ans1.Caption = ""
98    ans2.Caption = ""
99    ans3.Caption = ""
100   ans4.Caption = ""
101    
102'変数の説明
103'ansFlag: いくつ選択肢を設定したのかを記憶しておく箱
104'ansNo: 1から4の間で発生させた乱数の値を記憶しておく箱
105'colNo: Sheet1の3列目から6列目に格納されている選択肢の、何番目までを設定したのかを記憶しておく箱
106    
107    Dim ansFlag, ansNo, colNo
108    ansFlag = 0
109    ansNo = 0
110    colNo = 3
111    While ansFlag < 4 'ansFlagが4より小さいあいだ処理をくり返す
112        ansNo = Int(Rnd * 4 + 1) '0～1までの乱数Rnd に4をかけ、1を足し、小数点以下を切り捨てるInt
113        If UserForm1.Controls("ans" & ansNo).Caption = "" Then
114            UserForm1.Controls("ans" & ansNo).Caption = Sheet1.Cells(rowNo, colNo)
115            ansFlag = ansFlag + 1
116            
117        Sheet2.Range("A" & m).Value = Sheet1.Cells(rowNo, 1) '記録シートに問題番号を入力
118                    
119            '正答(Sheet1の3列目)がどのトグルボタンに設定されたかをCorrectAnsに記憶
120            If colNo = 3 Then
121                CorrectAns = ansNo
122            End If
123            colNo = colNo + 1
124        End If
125    Wend
126
127End Sub
128
129Private Sub answerJudg(tName)
130Dim n
131    n = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row + 1
132    
133    If UserForm1.Controls("ans" & tName).Value = False Then
134        Exit Sub
135    End If
136    
137    If CorrectAns = tName Then
138        info.Caption = "○ 正解"
139        CmntText = Sheet1.Cells(CmntRow, 7)
140        Sheet2.Range("B" & n).Value = "1" '記録用シートに正答を記録する
141    Else
142        info.Caption = "× 不正解"
143        CmntText = Sheet1.Cells(CmntRow, 7)
144        Sheet2.Range("B" & n).Value = "0" '記録用シートに誤答を記録する
145        
146    End If
147    info.Visible = True
148End Sub
149
150Private Sub ans1_Click()
151    answerJudg (1)
152End Sub
153
154Private Sub ans2_Click()
155    answerJudg (2)
156End Sub
157    
158Private Sub ans3_Click()
159    answerJudg (3)
160End Sub
161
162Private Sub ans4_Click()
163    answerJudg (4)
164End Sub

次に、「プログラム実行」と「データ処理」のマクロを作成するため、標準モジュールにそれぞれ以下のように入力します。

Module1
1  Option Explicit
2
3  Sub UserForm_Open()
4  UserForm1.Show
5  End Sub

Module2
1Option Explicit
2
3Private Const DATA_BEGIN_ROW     As Long = 2
4
5Public Sub sortAndSerialize()
6
7    Dim ws          As Worksheet
8    Dim lCol        As Long
9    Dim sDate       As String
10    Dim sCorrectAnswerRate  As String
11
12    Set ws = ThisWorkbook.ActiveSheet
13
14    With ws
15        lCol = ActiveCell.Column
16
17        sDate = .Cells(1, lCol).Value
18
19        Do Until sDate = ""
20            If Not IsDate(sDate) Then
21                Exit Do
22            End If
23
24            sCorrectAnswerRate = .Cells(1, lCol + 1).Value
25
26            If sCorrectAnswerRate <> "" And (Not IsDate(sCorrectAnswerRate)) Then
27                '並べ替え
28                Call sortDatas(ws, lCol)
29
30                '欠番挿入、重複番号削除
31                Call toSerialize(ws, lCol)
32
33                '日付移動、問題番号列削除
34                Call deleteQNoCol(ws, lCol)
35            End If
36
37            lCol = lCol + 1
38
39            sDate = .Cells(1, lCol).Value
40        Loop
41    End With
42End Sub
43
44Private Sub sortDatas(ByRef ws As Worksheet, ByVal lQNoCol As Long)
45
46    Dim lEndRow     As Long
47
48    With ws
49        lEndRow = .Cells(.Rows.Count, lQNoCol).End(xlUp).Row
50
51        With .Sort.SortFields
52            .Clear
53            .Add Key:=ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol), ws.Cells(lEndRow, lQNoCol)), _
54                 SortOn:=xlSortOnValues, _
55                 Order:=xlAscending, _
56                 DataOption:=xlSortNormal
57
58            '複数の異なる回答時：1を残す場合
59'            .Add Key:=ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol + 1), ws.Cells(lEndRow, lQNoCol + 1)), _
60                 SortOn:=xlSortOnValues, _
61                 Order:=xlAscending, _
62                 DataOption:=xlSortNormal
63            '複数の異なる回答時：0を残す場合
64            .Add Key:=ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol + 1), ws.Cells(lEndRow, lQNoCol + 1)), _
65                 SortOn:=xlSortOnValues, _
66                 Order:=xlDescending, _
67                 DataOption:=xlSortNormal
68        End With
69
70        With .Sort
71            .SetRange ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol), ws.Cells(lEndRow, lQNoCol + 1))
72            .Header = xlNo
73            .MatchCase = False
74            .Orientation = xlTopToBottom
75            .Apply
76        End With
77    End With
78End Sub
79
80Private Sub toSerialize(ByRef ws As Worksheet, ByVal lCol As Long)
81
82    Dim lCurrentRow As Long
83    Dim sCurrentQNo As String
84    Dim lCurrentQNo As Long
85    Dim lPrevQNo    As Long
86    Dim lInsertRows As Long
87
88    lCurrentRow = DATA_BEGIN_ROW
89
90    lPrevQNo = 0
91
92    With ws
93        sCurrentQNo = CStr(.Cells(lCurrentRow, lCol).Value)
94
95        Do Until sCurrentQNo = ""
96            lCurrentQNo = CLng(sCurrentQNo)
97
98            If lCurrentQNo > lPrevQNo + 1 Then
99                '欠番あり
100                lInsertRows = lCurrentQNo - lPrevQNo - 1
101
102                .Range(.Cells(lCurrentRow, lCol), .Cells(lCurrentRow + lInsertRows - 1, lCol + 1)).Insert Shift:=xlDown
103
104                .Cells(lCurrentRow + lInsertRows, lCol).AutoFill Destination:=.Range(.Cells(lCurrentRow, lCol), .Cells(lCurrentRow + lInsertRows, lCol)), Type:=xlFillSeries
105
106                With .Range(.Cells(lCurrentRow, lCol + 1), .Cells(lCurrentRow + lInsertRows - 1, lCol + 1))
107                    .NumberFormatLocal = "G/標準"
108                End With
109
110                lCurrentRow = lCurrentRow + lInsertRows + 1
111            ElseIf lPrevQNo = lCurrentQNo Then
112                '同番
113                .Range(.Cells(lCurrentRow - 1, lCol), .Cells(lCurrentRow - 1, lCol + 1)).Delete Shift:=xlUp
114            Else
115                lCurrentRow = lCurrentRow + 1
116            End If
117
118            sCurrentQNo = CStr(.Cells(lCurrentRow, lCol).Value)
119
120            lPrevQNo = .Cells(lCurrentRow - 1, lCol).Value
121        Loop
122    End With
123End Sub
124
125Private Sub deleteQNoCol(ByRef ws As Worksheet, ByVal lDateCol As Long)
126
127    With ws
128        .Cells(1, lDateCol + 1).Insert Shift:=xlDown
129
130        .Cells(1, lDateCol).Copy Destination:=.Cells(1, lDateCol + 1)
131
132        .Columns(lDateCol).Delete
133    End With
134End Sub

Sheet2に「スタートボタン」、Sheet3に「データ処理ボタン」をそれぞれ作成し、
スタートボタンにUserForm_Open()、データ処理ボタンにsortAndSerialize()のマクロを登録します。
以上でプログラムは完成です。

発生している問題

作成したプログラムを実行したところ、1問目で選択肢をクリックしたところで、正解か不正解か（オブジェクト「Info」）正しく表示されず、⑦の「次の問題に進みますか？」というメッセージボックスが表示されませんでした。

試したこと

ユーザーフォームのボタン作成に関する詳細のリンクが貼られていたのですが、サイトが閉鎖されたためか、リンクが開けませんでした。オブジェクト「Info」を間違えてラベルにしたのが原因ではないかと思いますが、オブジェクトは何に設定すれば良いかわからないです。
正解/不正解を表示させるアイデアがあればそれでもかまいませんので、ご意見いただければ幸いです。
よろしくお願いいたします。