読み仮名をエンターで確定しないで入力する方法

質問

エクセルで、漢字の読み方テストを作りたいと思っています。読み仮名を入力するとき、エンターで確定しなくても評価できるようにするにはどうしたらよいでしょうか。
ネット上に、漢字テストのページがありました。
http://www.gamedesign.jp/flash/yomi/yomi.html

独自に問題を作成し、児童に出題したいのですが、エクセルで作ることはできないでしょうか。
とくに、読み仮名を入力するとき、エンターを打たなくても採点してくれるところが機能的です。
エクセルでも、確定する前に、入力される読み仮名を取得することができますか。

また、正解の時の大きな赤い○を表示するのはどのようにしたらよいでしょう。
まだ、時間を測定したり、回答待ちのマクロも作成していないので、先の長い話ですがよろしくお願いします。

回答No.1

Wendy02 · ベストアンサー

同じようなものは作ったことがありますが、掲示板で公開するスペースが足りないような気がします。ヒントになる部分だけ触れておきます。

大事な部分は、たぶん、ご質問者さんが想像しない所だと思います。それは、問題をランダムに重複なく出すところです。それが出来なければ、完成しません。この部分は以下では書かれていません。一般的にはアルゴリズムが必要ですが、別にシートを用意してもよいと思います。

>読み仮名を入力するとき、エンターを打たなくても採点してくれるところが機能的です。
一定の時間内に、入力した所をチェックすればよいのですが、TextBoxがよいのではないかと思います。そんなに大した問題ではありません。以下は時間は15秒と大目に取っています。改行を入れれば、途中で解答チェックをしますが、間違っていれば、TextBox内がクリアされます。

以下、簡単なサンプルコードです。VBAが多少経験ある人なら、誰でも書けるような内容です。
・問題点は、TextBox等では、IMEのコントロールで動きが制約される可能性があります。
・タイムアウトのカウントは、もう少し難しいことを考えなくてはなりません。

シート1
コントロールツール
　CommandButton1　...1個
　TextBox1　　　　...1個
　場所は適当に置きます。

使用するセル
A1, C1
セルの高さと幅
ピクセル数　80　× 100

マクロは、シートモジュール(Sheet1)

'//
Dim myTime As Date
Dim cnt As Integer
Dim i As Integer
Dim arKan As Variant
Dim arFuri As Variant
'問題
Const Kanjis = "未曾有,嚥下,声高,東風,作務衣"
'解答
Const Furiganas = "みぞう,えんげ,こわだか,こち,さむえ"

Private Sub CommandButton1_Click()
　cnt = 0: i = 0
　TextBox1.Text = ""
　arKan = Split(Kanjis, ",")
　arFuri = Split(Furiganas, ",")
　With Range("A1", "C1")
　　.ClearContents
　　.ClearFormats
　End With
　Range("A1").Font.Size = 20
　Range("c1").Font.Size = 40
　TextBox1.IMEMode = fmIMEModeHiragana
　myTime = Now + TimeSerial(0, 0, 15)
　Call SetQuestion
　If i > UBound(arKan) + 1 Then
　　Range("A1").ClearContents
　　TextBox1.Text = ""
　End If
End Sub
Private Sub SetQuestion()
　TextBox1.Text = ""
　Range("A1").Value = arKan(i)
　myTime = Now + TimeSerial(0, 0, 5)
　TextBox1.Activate
　Application.OnTime myTime, Me.Name & ".CheckAnswer"
End Sub
'続く

お礼

詳しく回答をいただきありがとうございます。
しばらく、考えさせていただきましたが、私には難しすぎました。
今しばらく勉強してから挑戦いたします。

回答No.2

Wendy02

'前回からの続き
Private Sub CheckAnswer()
　If Trim(TextBox1.Text) = "" Then
　　Range("C1").Font.ColorIndex = 0
　　Range("C1").Value = "×"
　　Application.Wait Now + TimeSerial(0, 0, 2)
　ElseIf StrComp(Trim(TextBox1.Text), arFuri(i)) <> 0 Then
　　Range("C1").Font.ColorIndex = 0
　　Range("C1").Value = "×"
　　Application.Wait Now + TimeSerial(0, 0, 2)
　ElseIf StrComp(Trim(TextBox1.Text), arFuri(i)) = 0 Then
　　Beep
　　Range("C1").Font.ColorIndex = 3
　　Range("C1").Value = "○"
　　cnt = cnt + 1
　Else
　　Range("C1").Font.ColorIndex = 0
　　Range("C1").Value = "×"
　End If
　With Range("A1")
　　.Characters(1, 3).PhoneticCharacters = arFuri(i)
　　.Phonetics.Font.Size = 8
　　.Phonetics.Alignment = xlPhoneticAlignDistributed
　　.Phonetics.Visible = True
　 End With
　i = i + 1
　If i > UBound(arKan) Then
　　 TextBox1.Text = ""
　　 Beep
　　 Range("C1").Font.ColorIndex = 0
　　 Range("C1").Font.Size = 20
　　 Range("C1").Value = "正解数： " & cnt & "/" & (UBound(arKan) + 1)
　Else
　　Application.Wait Now + TimeSerial(0, 0, 3)
　　Range("A1", "C1").ClearContents
　　If UBound(arKan) > (i - 1) Then
　　　TextBox1.Activate
　　　Call SetQuestion
　　End If
　End If
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　'改行で待ち時間なしになる
　If KeyCode = 13 Then
　 On Error Resume Next
　 If StrComp(Trim(TextBox1.Text), arFuri(i), 1) <> 0 Then
　　　TextBox1.Text = ""
　 Else
　　　Application.OnTime myTime, Me.Name & ".CheckAnswer", , False
　　　Call CheckAnswer
　 End If
　End If
　On Error GoTo 0
End Sub