Excel(VBA)でクイズゲームを作ろう！応用編
こんにちは「つけらっとゲームス」プログラム担当のとちです。
今回は1月29日の記事で作ったクイズゲームを少し高性能化します。というわけで初回分を読んでいない方はコチラからどうぞ！
改良点として初回記事で予告したとおり、こんな感じです。
（1）10問以上の問題から、10個の問題をランダムに出題する。
（2）選択肢が2つ、または3つの問題にも対応する。
（3）Excelファイルを起動した時点でクイズゲームを動かす。
なお、この記事のスクショについて、わたしのPCに入っているMicrosoft office Home and Business 2016でスクショを撮りました。
ですので微妙に表示が異なる可能性がありますが、デスクトップ版のExcelであれば、開発に使用するVBA（Microsoft Visual Basic for Applications）は同じで作業内容も変わりません。Microsoft365のExcelでも動作します。
ランダム出題の対応
前回の記事で作ったExcelファイル（.xlsm）には問題が10個しかありませんでした。なので、毎回同じクイズしか出題されませんし、出題される順番も固定でした。
答えを覚えておくと誰でも満点をとれる手軽さは良いのですが、クイズゲームとしては微妙ですよね。そこで問題はいくらでも用意できるようにして、その中から10問出題するように改良します。
前回の問題はこんな感じでしたが…
今回はサンプル問題を20問にします。
選択肢が空欄の問題もありますよね？
これは三択（二択）問題に対応する改良をするからです…とりあえず20問用意するのも大変なので、CSVファイルも貼っておきますね。
クイズゲームq20.csvをダウンロードして、開発用xlsmファイルの問題シートにコピペしておきましょう。
当然プログラムの修正も必要になります。
これはあとで他の改良点も含めて対応することにします。
三択（二択）問題の対応
初回記事でQuizDataの内容にも触れましたが、改めてデータ構造の説明をしたいと思います。というわけでスクショを再掲。
データ構造はこんな感じになっています。
・Ａ列 問題文
・Ｂ列 選択肢1
・Ｃ列 選択肢2
・Ｄ列 選択肢3
・Ｅ列 選択肢4
・Ｆ列 答え
四択クイズなので選択肢1～4が必要です。その隣に答えのデータが入っているわけですが、再掲されたスクショをよく見るとD列、E列が空白の問題があります。
この空白がある行が三択(二択)問題になっています。
しかし、答えは必ずF列に書くようにしてください。
このルールを守ってさえいればオリジナル問題を増やしても構いません。
こちらの改良も当然プログラム修正が必要となりますが、あとで他の改良点も含めて対応することにします。
クイズゲームの自動起動対応
現在、このゲームを遊ぶためにはExcelファイルを開き、メニューバーの「開発」＞「Visual Basic」＞フォーム「QuizGame」を選んで、再生ボタンを押すという手順が必要です。
正直、これは面倒臭い！
できればExcelファイルを開いた時点でゲームが動いて欲しいですよね。
以下の「2.Excelファイルを開いたらゲーム起動」でも解説していますが、ここで改めて説明しますね。
まずはスクリーンショットのオレンジ枠で囲んでいる「ThisWorkbook」をダブルクリックしましょう。
すると、コードを入力する画面が表示されると思います。
次のスクショのオレンジ枠で囲んでいる場所を注目、プルダウンメニューになっているので変更します。
・(General) → Workbook にします！
・(Declarations) → Open にします！
そしたら、以下のコードをコピペしましょう。
Private Sub Workbook_Open()
QuizGame.Show
End SubこれだけでOK！
保存したらExcelファイルを閉じて試してみるとよいでしょう！
プログラムコードをコピペしよう！
自動起動以外の改良点に対応したプログラムコードをコピペしましょう。コードそのものの解説は同テーマの次の記事で詳しくしたいと思っています。少々お待ちください。
では、フォーム「QuizGame」をダブルクリックし、「はじめる」ボタンをダブルクリック、プログラムコードが並んでいる画面を表示しましょう。
表示されたプログラムコードを一旦全て消去して、以下のコードをコピペしてください。
Option Explicit
Dim QuizNo As Integer '【変数定義】現在出題されているクイズIndex
Dim QuizAns As Integer '【 〃 】現在出題されているクイズの答え
Dim UserPoint As Integer '【 〃 】プレイヤーの点数
Dim DtSt As String '【 〃 】クイズデータのワークシート名
Dim QuizMax As Integer '【 〃 】クイズデータの最大数 VerUp
Dim QuizCount As Integer '【 〃 】出題されたクイズ数 VerUp
'----------------------------------------------------------------
' UserForm 初期化
'----------------------------------------------------------------
Sub UserForm_Initialize() '
'
Randomize ' 乱数初期化[VerUp]
DtSt = "QuizData" ' クイズデータが格納されているワークシート名
TitleImage.Top = 0 ' タイトル画像を左上隅に移動させる
TitleImage.Left = 0 ' 〃
TitleLbl.Top = 72 ' タイトルラベルを所定の場所に移動させる
TitleLbl.Left = 60 ' 〃
' '
'--- VerUp [ｺｺｶﾗ] -------- '
'--- ループで問題数をカウントする方法 '
'--- '
'Dim wTxt As String '【変数定義】問題文検出用の変数
'Do While True '■ループ
' wTxt = Worksheets(DtSt).Cells(QuizMax + 1, 1) '├ 問題文を取得
' If wTxt = "" Or wTxt = Null Then Exit Do '├ ◆問題文が空白またはNullの場合 >> ループを抜ける
' QuizMax = QuizMax + 1 '├ クイズデータの最大数をカウントアップ
'Loop '└ ループ終端
'--- '
'--- Worksheet関数 CountIf で問題数をカウントする方法 '
'--- '
QuizMax = WorksheetFunction.CountIf(Worksheets(DtSt).Range("A1:A50"), "*")
'--- VerUp [ｺｺﾏﾃﾞ] ------- '
'
End Sub '
'----------------------------------------------------------------
' はじめるボタンをクリック
'----------------------------------------------------------------
Sub StartBtn_Click() '
'
QuizNo = 1 '［初期化］出題されるクイズIndex
'
'--- VerUp [ｺｺｶﾗ] -------- '
Do While True '■ループ
Worksheets(DtSt).Cells(QuizNo, 7) = "" '├ 出題済みセルを初期化
QuizNo = QuizNo + 1 '├ 出題されるクイズIndexのカウントアップ
If QuizNo > QuizMax Then Exit Do '├ ◆クイズIndexがクイズデータの最大数を超えた場合 >> ループを抜ける
Loop '└ ループ終端
'--- VerUp [ｺｺﾏﾃﾞ] ------- '
'
QuizAns = 0 '［初期化］出題されたクイズの答え
UserPoint = 0 '［初期化］プレイヤーの点数
QuizCount = 1 '［初期化］出題されたクイズ数
'
UserPointLbl.Caption = UserPoint & "点" ' 答案用紙の点数表示
Nokoribl.Caption = "残り10問" ' 問題残り数の表示
'
TitleImage.Visible = False ' タイトル画像 非表示化
TitleLbl.Visible = False ' タイトルラベル非表示化
StartBtn.Visible = False ' はじめるボタン非表示化
QuizDataGet ' クイズデータを取得
'
End Sub '
'----------------------------------------------------------------
' 次へボタンをクリック
'----------------------------------------------------------------
Sub NextBtn_Click() '
'
If QuizCount >= 11 Then '■出題されたクイズ数が11以上の場合 終了処理
Dim KekaTx As String '├【変数定義】結果テキスト
TitleImage.Visible = True '├ タイトル画像 表示
TitleLbl.Visible = True '├ タイトルラベル表示
StartBtn.Visible = True '├ はじめるボタン表示
KekaTx = "難しかったかな？" '├［初期化］結果テキスト
If UserPoint >= 30 Then KekaTx = "ちょっと残念..." '├◆点数が 30点以上のテキストを結果テキストへ代入
If UserPoint >= 60 Then KekaTx = "まぁまぁかな？" '├◆点数が 60点以上 〃 〃
If UserPoint >= 80 Then KekaTx = "惜しい！" '├◆点数が 80点以上 〃 〃
If UserPoint >= 100 Then KekaTx = "満点おめでとう!" '├◆点数が100点以上 〃 〃
TitleLbl.Caption = KekaTx '├ 結果テキストの画面反映
StartBtn.Caption = "もう１回！" '├ はじめるボタンのキャプション変更
Else '■出題されるクイズIndexが11以上ではない場合
QuizDataGet '└ 次のクイズデータを取得
End If '
'
End Sub '
'----------------------------------------------------------------
' 選択肢ボタン1～4をクリック
'----------------------------------------------------------------
Sub QSelBtn1_Click() '
If QuizAns = 1 Then UserPoint = UserPoint + 10 '■クイズの答えが「1」の場合 >> 点数+10
QAnsMB1.Visible = True 'マルバツラベル1を表示
QuizAnsSelectAfter '解答後の処理
End Sub '
Sub QSelBtn2_Click() '
If QuizAns = 2 Then UserPoint = UserPoint + 10 '■クイズの答えが「2」の場合 >> 点数+10
QAnsMB2.Visible = True 'マルバツラベル2を表示
QuizAnsSelectAfter '解答後の処理
End Sub '
Sub QSelBtn3_Click() '
If QuizAns = 3 Then UserPoint = UserPoint + 10 '■クイズの答えが「3」の場合 >> 点数+10
QAnsMB3.Visible = True 'マルバツラベル3を表示
QuizAnsSelectAfter '解答後の処理
End Sub '
Sub QSelBtn4_Click() '
If QuizAns = 4 Then UserPoint = UserPoint + 10 '■クイズの答えが「4」の場合 >> 点数+10
QAnsMB4.Visible = True 'マルバツラベル4を表示
QuizAnsSelectAfter '解答後の処理
End Sub '
'----------------------------------------------------------------
' 解答後の処理
'----------------------------------------------------------------
Sub QuizAnsSelectAfter() '
'
QSelBtn1.Enabled = False ' 選択肢ボタン1 クリック不可
QSelBtn2.Enabled = False ' 〃 2 〃
QSelBtn3.Enabled = False ' 〃 3 〃
QSelBtn4.Enabled = False ' 〃 4 〃
'
QAnsLbl.Visible = True '答えラベル 表示
NextBtn.Visible = True '次へボタン 表示
QuizCount = QuizCount + 1 '出題されたクイズ数のカウントアップ
UserPointLbl.Caption = UserPoint & "点" '点数の更新
Nokoribl.Caption = "残り" & (11 - QuizCount) & "問" '残り問題数の更新
NextBtn.SetFocus '次へボタンにフォーカスを移す
'
NextBtn.Caption = "次へ" '次へボタンのキャプションを初期化 [バグ対応][VerUp]
If QuizCount >= 11 Then NextBtn.Caption = "結果発表" '■クイズIndexが11以上の場合 >> 次へボタンのキャプションを結果発表にする[VerUp]
'
End Sub '
'----------------------------------------------------------------
' 問題文と正解を取得し、画面表示する
'----------------------------------------------------------------
Sub QuizDataGet() '
'
Dim ZumiFlg As String '【変数定義】出題済みフラグ VerUp
NextBtn.Visible = False ' 次へボタン 非表示化
QAnsLbl.Visible = False ' 答えラベル 〃
QAnsMB1.Visible = False ' マルバツラベル1 〃
QAnsMB2.Visible = False ' マルバツラベル2 〃
QAnsMB3.Visible = False ' マルバツラベル3 〃
QAnsMB4.Visible = False ' マルバツラベル4 〃
QSelBtn1.Enabled = True ' 選択肢ボタン1 クリック可
QSelBtn2.Enabled = True ' 選択肢ボタン2 〃
QSelBtn3.Enabled = True ' 選択肢ボタン3 〃
QSelBtn4.Enabled = True ' 選択肢ボタン4 〃
'
'--- VerUp [ｺｺｶﾗ] -------- '
QuizNo = fRandom(QuizMax, 1) ' 出題されるクイズIndexをランダム取得
Do While True ' ■ループ
ZumiFlg = Worksheets(DtSt).Cells(QuizNo, 7) ' ├ 出題済みフラグを取得
If ZumiFlg = "" Then Exit Do ' ├ ◆出題済みフラグが立っていない場合 >> ループを抜ける
QuizNo = QuizNo + 1 ' ├ 出題されるクイズIndexを+1
If QuizNo > QuizCount Then QuizNo = 1 ' ├ ◆クイズIndexがクイズデータの最大数を超えた場合 >> クイズIndexを1に戻す
Loop ' └ ループ終端
'--- VerUp [ｺｺﾏﾃﾞ] ------- '
'
QuizTxLbl.Caption = Worksheets(DtSt).Cells(QuizNo, 1) ' 問題 データ取得
QSelBtn1.Caption = Worksheets(DtSt).Cells(QuizNo, 2) ' 選択肢1 〃
QSelBtn2.Caption = Worksheets(DtSt).Cells(QuizNo, 3) ' 選択肢2 〃
QSelBtn3.Caption = Worksheets(DtSt).Cells(QuizNo, 4) ' 選択肢3 〃
QSelBtn4.Caption = Worksheets(DtSt).Cells(QuizNo, 5) ' 選択肢4 〃
QuizAns = Val(Worksheets(DtSt).Cells(QuizNo, 6)) ' 答え 〃
Worksheets(DtSt).Cells(QuizNo, 7) = "zumi" ' 出題済みフラグを立てる VerUp
'
'--- VerUp [ｺｺｶﾗ] -------- '
QSelBtn3.Visible = True ' 選択肢ボタン3 表示化(初期化)
QSelBtn4.Visible = True ' 選択肢ボタン4 表示化(初期化)
If QSelBtn3.Caption = "" Then QSelBtn3.Visible = False ' ■選択肢ボタン3のキャプションが空白の場合 >> 選択肢ボタン3を非表示化
If QSelBtn4.Caption = "" Then QSelBtn4.Visible = False ' ■選択肢ボタン4のキャプションが空白の場合 >> 選択肢ボタン4を非表示化
'--- VerUp [ｺｺﾏﾃﾞ] ------- '
'
'答えラベルに表示するテキストを編集 '
QAnsLbl.Caption = "答：" & Worksheets(DtSt).Cells(QuizNo, QuizAns + 1)
QAnsMB1.Caption = "×" ' マルバツラベルの初期化
QAnsMB2.Caption = "×" ' 〃
QAnsMB3.Caption = "×" ' 〃
QAnsMB4.Caption = "×" ' 〃
If QuizAns = 1 Then QAnsMB1.Caption = "〇" '■答えが「1」の場合 >> マルバツラベル1を〇にする
If QuizAns = 2 Then QAnsMB2.Caption = "〇" '■答えが「2」の場合 >> マルバツラベル2を〇にする
If QuizAns = 3 Then QAnsMB3.Caption = "〇" '■答えが「3」の場合 >> マルバツラベル3を〇にする
If QuizAns = 4 Then QAnsMB4.Caption = "〇" '■答えが「4」の場合 >> マルバツラベル4を〇にする
End Sub '
'----------------------------------------------------------------
' 最大値と最小値を指定した乱数取得ファンクション VerUp
'----------------------------------------------------------------
Function fRandom(dMax As Integer, dMin As Integer) '
fRandom = Int(dMax * Rnd + dMin) ' 最小～最大値の間の値を乱数を用いて返答する
End Function 'コードの中身を見ると、そんなに大きく変わっていないように見えます。
今回の対応で追加になった箇所はコメントに [VerUp] と書かれている部分です。
また、前回のプログラムで実はバグがありまして、
ゲームの結果発表後、「次へ」ボタンのキャプションが結果発表のままになっていたので修正しました。
バグ対応の箇所はコメントに [バグ対応] と書いています。
普段からコード修正をする場合は、どこを修正したかわかるようすると良いです。バージョン管理ソフトを使用してもいいですね。コメントに日付と検索できるキーワードを書いておくと便利です。
ファイルやフォルダごとバックアップをとる場合も、バックアップしたファイルやフォルダには日付を付けておくと後々自分が助かります。
修正したつもりで運用したら、実は以前より酷いバグが残ってた。なんて時は元に戻した方がいいからね…
ゲームを動かしてみる
実際にゲームを動かしてみましょう。自動起動の対応が上手く機能していれば、Excelファイルを開いた時点でゲーム画面が表示されるハズです。
20問のクイズからランダムで出題されるようになり、三択クイズにも対応できているハズです。
というわけで、目標にしていた３つの改良点は実装されました。偶然にも発生していた不具合も改善しています。プログラム開発においてミスはよくあることですからね…
とはいえ、なぜ改良できたのか、なぜ不具合が治ったのか？
そもそも、なんでこのプログラムが動いているのか？
次回はその謎を解くべく、プログラムコードの中身を解説していきたいと思います。
以降はオススメ記事の紹介です。
「読むとゲームができる」記事は、このマガジンにまとめています。
情報関連の勉強をしている方、復習したい方にはコチラ！
基本情報技術者試験のアルゴリズムとか苦手！って方にもオススメです。
いいなと思ったら応援しよう！
