今回は作成したツールをご紹介します。
遊び心で作ったツールである事はご了承ください。
タイトルの通り、子供と一緒にさんすうの勉強ができるツールです。
このツールをそのまま使うというよりも、こういうものも手軽に作れるというご紹介となります。
一番最後にサンプルファイルと全コードを記載します。
コードをコピーして作成する場合は、「図の挿入」等の準備が必要です。
1．ツールの動画
まず最初に動画でどのようなツールかご覧ください。
※動画はわざと３問目を難しくしています。
2.ツールの目的
このツールを作った目的は大きく2つです。
1つ目は難しいコードやロジックをほとんど使わずに、比較的簡単にこのようなツールを作れるというご紹介です。
2つ目は子供にさんすうを楽しみながら練習してもらいながら、Excelに自然と慣れてもらう。
「これはどうやってうごいているの？」と興味をもってもらえたら最高ですね。
3.工夫した部分
無機質な計算を延々とさせるより、楽しいと感じながらできるよう工夫してみました。
また、セリフや文字は小さな子供でも読めるようにひらがなのみ使用しています。
VBA自体も複雑な作りにならないよう、簡単な書き方にしています。
4.使い方
簡単な使い方のご説明をします。
「さいしょから」をクリックすると猫が最初のセリフを表示します。
開始をクリックすると、「1もんめ〜」というセリフが表示され、問題が表示されます。
設定数分の問題を正解すると、最初に戻ります。
途中で間違えても最初に戻ります。
また、途中で「さいしょから」をクリックしても最初に戻ります。
実は「かいし」を押しても最初からになります。
5.コードの解説
コードの解説です。
ロジックもコーディングも極力簡単に書きました。
コードは大きく分けて2つに分かれます。
Sheet1モジュールに書かれた、特定のセル(F10)が変更された際のイベントと、標準モジュールに書かれた機能部分の各パーツとなります。
順番にご説明します。
Sheet1モジュールのコード
Sheet1モジュールに書かれたコードの説明です。
F10が変更された時に、計算結果をチェックするコードを呼び出します。
Sheet1(Sheet1)モジュールに「Worksheet_Change」イベントを選択して次のコードを書きます。
「If Intersect(Target, Range(“F10”)) Is Nothing Then」で「F10」以外はプロシージャを抜け、「F10」が変更された時に、「F10」が空白じゃなければ「計算結果のチェック」を呼び出しています。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F10")) Is Nothing Then
Exit Sub
Else
If Cells(10, 6) <> "" Then
Call myCheck
End If
End If
End Sub標準モジュールのコード
標準モジュールに書かれたコードの説明です。
プロシージャは「計算結果をチェック」、「かいしボタン」、「さいしょからボタン」、「セルをクリア」、「問題用の整数を作成」、「メッセージ内容」の6つに分けました。
長くなるので、簡単に説明します。
宣言セクション
こちらで、「Sleep関数」と「現時点の問題数」と「問題数の設定」を宣言しています。
宣言セクションとは、モジュール内の一番上のプロシージャよりさらに上の部分です。
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Public myCount As Long
Const LastCount As Long = 3 '問題数を指定計算結果をチェック
こちらで、回答のチェックを行っています。
最初に回答が正しいか判定し、正しい場合に問題数で表示するメッセージを選択しています。
メッセージ選択後、次の実行を分岐します。
最後に間違った場合のコードです。
※デフォルトでは間違えると「でなおしてこい」となっているため、「Function MsgStr」で便宜変更して下さい。
Sub myCheck()
'回答チェック
'問題数チェック(デフォルト3)
Dim MyStr As String
Dim StrFlag As String
With ActiveSheet
If .Cells(10, 2) + .Cells(10, 4) = .Cells(10, 6) Then '最初に回答が正しいかチェック
myCount = myCount + 1
If myCount = LastCount Then 'ラストの問題
StrFlag = "Last" 'メッセージの選択キーワード
ElseIf myCount < LastCount Then 'ラスト未満の問題
StrFlag = "Correct" 'メッセージの選択キーワード
Else 'それ以外(全て正解)
StrFlag = "AllCorrect" 'メッセージの選択キーワード
myCount = 1 '問題数をリセット
End If
With ActiveSheet.Shapes("角丸四角形吹き出し 3") 'テキストにメッセージとサイズを反映
.Width = 110
.Left = 500
.Top = 30
.TextFrame.Characters.Text = MsgStr(StrFlag)
End With
Sleep 2000
If StrFlag = "AllCorrect" Then
Call CellClear 'セルクリア
Else
Call IntMaker '整数生成
.Cells(10, 6) = ""
End If
Else
StrFlag = "Mistake"
With ActiveSheet.Shapes("角丸四角形吹き出し 3")
.Width = 110
.Left = 500
.Top = 30
.TextFrame.Characters.Text = MsgStr(StrFlag)
End With
Call CellClear 'セルクリア
End If
End With
End Sub「かいし」と「さいしょから」ボタン
「かいし」と「さいしょから」ボタンをクリックされた時のコードです。
テキストボックスのサイズとメッセージを表示するコードです。
Sub Start_Click()
'「かいし」ボタンクリック時のコード
Dim MyStr As String
myCount = 1
Call IntMaker '整数生成
With ActiveSheet.Shapes("角丸四角形吹き出し 3")
.Width = 100
.Left = 500
.Top = 30
.TextFrame.Characters.Text = MsgStr("Start")
End With
End Sub
Sub ReStart_Click()
'「さいしょから」ボタンをクリックした時のコード
Dim MyStr As String
Call CellClear 'セルクリア
With ActiveSheet.Shapes("角丸四角形吹き出し 3")
.Width = 200
.Left = 520
.Top = 30
.TextFrame.Characters.Text = MsgStr("ReStart")
End With
End Subセルクリア
B10、D10、F10をクリアするだけのコードです。
Function CellClear()
'セルクリア
With ActiveSheet
.Cells(10, 2) = ""
.Cells(10, 4) = ""
.Cells(10, 6) = ""
End With
End Function問題用の整数を作成する
単精度小数点型の乱数を返す「Rnd関数」を使用して、ランダムに数字を出力して、設定したLow、Hight内の整数を作成しています。
「Const low As Integer = 1」と「Const high As Integer = 10」の数字を変更すると出力範囲が変更されます。
Low=1、High=100とすると1~100で出題されます。
Function IntMaker()
'計算用整数作成
'整数1～10(デフォルト1～10)
Const low As Integer = 1
Const high As Integer = 10
Dim i As Long
Randomize
With ActiveSheet
i = Int((high - low + 1) * Rnd + low)
.Cells(10, 2) = i
i = Int((high - low + 1) * Rnd + low)
.Cells(10, 4) = i
End With
End Functionテキストのメッセージ選択
こちらで予め作成されたメッセージを選択しています。
「& vbCrLf & _」はメッセージを改行しています。
変数の「LastCount」、「myCount」は書き換えない様にしてください。
こちらの内容を書き換えると、適宜表示されるメッセージが変更されます。
※上記でも触れましたが、ミスの場合のメッセージが「でなおしてこい」なので、修正して下さい。
Function MsgStr(ByVal StrFlag As String) As String
'表示文字列
Select Case StrFlag
Case "First"
'===================最初======================
MsgStr = "さんすうのれんしゅうだよ！" & vbCrLf & _
LastCount & "もんせいかいしたら" & vbCrLf & _
"おこづかいがもらえるよ！" & vbCrLf & _
"かいしをおしてね！" & vbCrLf & _
"やりなおすときはさいしょからをおしてね！"
Case "Start"
'===================開始======================
MsgStr = myCount & "もんめだよ！" & vbCrLf & _
"わかるかな？" & vbCrLf & _
"がんばってね！"
Case "ReStart"
'================さいしょから==================
MsgStr = "さんすうのれんしゅうだよ！" & vbCrLf & _
"３もんせいかいしたら" & vbCrLf & _
"おこづかいがもらえるよ！" & vbCrLf & _
"かいしをおしてね！" & vbCrLf & _
"やりなおすときはさいしょからをおしてね！"
Case "Last"
'===================最後======================
MsgStr = "だいせいかい！" & vbCrLf & _
"すごいすごいっ" & vbCrLf & _
"さあさいごだよ！" & vbCrLf & _
"わかるかな！？"
Case "Correct"
'===================正解======================
MsgStr = "だいせいかい！" & vbCrLf & _
"すごいすごいっ" & vbCrLf & _
myCount & "もんめだよ！"
Case "AllCorrect"
'=================全問正解====================
MsgStr = "だいせいかい！" & vbCrLf & _
"すごーい！" & vbCrLf & _
"ぜんぶせいかいだよ！"
Case "Mistake"
'=================計算ミス====================
MsgStr = "でなおしてこい"
End Select
End Function6.全コード
Sheet1(Sheet1)モジュール
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F10")) Is Nothing Then
Exit Sub
Else
If Cells(10, 6) <> "" Then
Call myCheck
End If
End If
End SubModule1
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Public myCount As Long
Const LastCount As Long = 3 '問題数を指定
Sub myCheck()
'回答チェック
'問題数チェック(デフォルト3)
Dim MyStr As String
Dim StrFlag As String
With ActiveSheet
If .Cells(10, 2) + .Cells(10, 4) = .Cells(10, 6) Then '最初に回答が正しいかチェック
myCount = myCount + 1
If myCount = LastCount Then 'ラストの問題
StrFlag = "Last" 'メッセージの選択キーワード
ElseIf myCount < LastCount Then 'ラスト未満の問題
StrFlag = "Correct" 'メッセージの選択キーワード
Else 'それ以外(全て正解)
StrFlag = "AllCorrect" 'メッセージの選択キーワード
myCount = 1 '問題数をリセット
End If
With ActiveSheet.Shapes("角丸四角形吹き出し 3") 'テキストにメッセージとサイズを反映
.Width = 110
.Left = 500
.Top = 30
.TextFrame.Characters.Text = MsgStr(StrFlag)
End With
Sleep 2000
If StrFlag = "AllCorrect" Then
Call CellClear 'セルクリア
Else
Call IntMaker '整数生成
.Cells(10, 6) = ""
End If
Else
StrFlag = "Mistake"
With ActiveSheet.Shapes("角丸四角形吹き出し 3")
.Width = 100
.Left = 500
.Top = 30
.TextFrame.Characters.Text = MsgStr(StrFlag)
End With
Call CellClear 'セルクリア
End If
End With
End Sub
Sub Start_Click()
'「かいし」ボタンクリック時のコード
Dim MyStr As String
myCount = 1
Call IntMaker '整数生成
With ActiveSheet.Shapes("角丸四角形吹き出し 3")
.Width = 100
.Left = 500
.Top = 30
.TextFrame.Characters.Text = MsgStr("Start")
End With
End Sub
Sub ReStart_Click()
'「さいしょから」ボタンをクリックした時のコード
Dim MyStr As String
Call CellClear 'セルクリア
With ActiveSheet.Shapes("角丸四角形吹き出し 3")
.Width = 200
.Left = 520
.Top = 30
.TextFrame.Characters.Text = MsgStr("ReStart")
End With
End Sub
Function CellClear()
'セルクリア
With ActiveSheet
.Cells(10, 2) = ""
.Cells(10, 4) = ""
.Cells(10, 6) = ""
End With
End Function
Function IntMaker()
'計算用整数作成
'整数1～10(デフォルト1～10)
Const low As Integer = 1
Const high As Integer = 10
Dim i As Long
Randomize
With ActiveSheet
i = Int((high - low + 1) * Rnd + low)
.Cells(10, 2) = i
i = Int((high - low + 1) * Rnd + low)
.Cells(10, 4) = i
End With
End Function
Function MsgStr(ByVal StrFlag As String) As String
'表示文字列
Select Case StrFlag
Case "First"
'===================最初======================
MsgStr = "さんすうのれんしゅうだよ！" & vbCrLf & _
LastCount & "もんせいかいしたら" & vbCrLf & _
"おこづかいがもらえるよ！" & vbCrLf & _
"かいしをおしてね！" & vbCrLf & _
"やりなおすときはさいしょからをおしてね！"
Case "Start"
'===================開始======================
MsgStr = myCount & "もんめだよ！" & vbCrLf & _
"わかるかな？" & vbCrLf & _
"がんばってね！"
Case "ReStart"
'================さいしょから==================
MsgStr = "さんすうのれんしゅうだよ！" & vbCrLf & _
LastCount & "もんせいかいしたら" & vbCrLf & _
"おこづかいがもらえるよ！" & vbCrLf & _
"かいしをおしてね！" & vbCrLf & _
"やりなおすときはさいしょからをおしてね！"
Case "Last"
'===================最後======================
MsgStr = "だいせいかい！" & vbCrLf & _
"すごいすごいっ" & vbCrLf & _
"さあさいごだよ！" & vbCrLf & _
"わかるかな！？"
Case "Correct"
'===================正解======================
MsgStr = "だいせいかい！" & vbCrLf & _
"すごいすごいっ" & vbCrLf & _
myCount & "もんめだよ！"
Case "AllCorrect"
'=================全問正解====================
MsgStr = "だいせいかい！" & vbCrLf & _
"すごーい！" & vbCrLf & _
"ぜんぶせいかいだよ！"
Case "Mistake"
'=================全問正解====================
MsgStr = "でなおしてこい"
End Select
End Function7.サンプルファイル
こちらからサンプルファイルをダウンロードできます。
