ここから本文です

Excel VBAである処理中のみ時間が加算がされない方法とは? ご教授をお願いいたし...

sys********さん

2014/3/2401:00:16

Excel VBAである処理中のみ時間が加算がされない方法とは?
ご教授をお願いいたします。

VBAを使用して制限時間があるクイズ作成を行っているのですが、問題文表示がされている間は時間が減らない(加算されない)方法を探しているのですが、まったく見つからず困っています。

行っている処理は、問題が始まったら、セル(A,1)にある問題文が表示され答えを入力後、セル(A,2)にある答えと入力した答えがあっていたら、次の行に移動する仕組みです。
時間関係の関数は、Timer関数を使用しています。問題文が表示される前の時間と問題文が表示されている時間を引いてみたのですがうまくいかず困っています。制限時間のみだけでしたら、処理が行われます。


Sub Question()

Dim StartTime As Long
Dim buf As String
Dim objQ As Range
Dim n As Integer '行のカウント
Dim keika As Long '経過時間(秒)

Dim stopS As Long 'ストップ時間計算用_はじめ
Dim stopE As Long 'ストップ時間計算用_終わり
Dim s_time As Long

n = 1
keika = 0 '初期値のため、0を格納
s_time = 0 '初期値のため、0を格納

'「現在時刻」を変数startTimeに格納
StartTime = Timer

Do
keika = Timer - StartTime - s_time
DoEvents

If keika <= 360 Then '制限時間6分間
If Not Cells(n, 1) = "" Then
stopS = Timer
buf = InputBox(Cells(n, 1)) 'iは行・2は列(B)

If buf = "" Then
stopE = Timer
s_time = stopG - stopS '問題文が表示をされている間の秒数
MsgBox ("答えを入力してください")
Else
stopE = Timer
s_time = stopG - stopS '問題文が表示をされている間の秒数

If Cells(n, 2).Value = buf Then
MsgBox ("正解")
n = n + 1 'セルの行を一段下げる処理
Else
MsgBox ("不正解")
End If
End If
Else
MsgBox ("時間内に問題を回答できました!")
GoTo Over
End If
Else
GoTo Timeout
End If
Loop '6分経過したためDo~Loop文を抜けた
Timeout:
MsgBox ("TimeOut!次は時間制限内に終らせてください。")
Over:
End Sub

どなたかご教授をお願いいたします。

補足gargohgさん
答えていただきありがとうございます!制限時間終了でも答えが書けてしまいますね。。。こちら、今回は使用しないのですが、今後他ので使用させていただきます。まだ、回答を募集をしていますので、どなたか申し訳ないのですがお願いいたします。

閲覧数:
180
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

gar********さん

編集あり2014/3/2409:27:05

今の状態だと答え入力中に制限時間を超えても
InputBoxで処理が止まっているので一度答えを決定しないと制限時間を超えても入力ができてしまいます

なので時間が来たら強制終了するように自分なりに作ってみました
UserForm使用です。

標準モジュール
Public n As Long

Sub test()
Dim ST As Long '開始時刻
Const ET = 30 '制限時間(秒)

n = 1
UserForm1.Show 0
ST = Timer
Do
DoEvents
UserForm1.Label2.Caption = "残り時間:" & Int(ET - (Timer - ST)) & "秒"
If Timer - ST > ET Then Exit Do
Loop

MsgBox "時間終了"
Unload UserForm1
MsgBox n - 1 & "問正解"
End Sub

'UserForm
'Label1 : 問題文
'Label2 : 残り時間表示
'TextBox1 : 答え入力欄
'CommandButton1 : 答え決定欄

Private Sub UserForm_Initialize()
Label1.Caption = Cells(n, 1)
End Sub

Private Sub CommandButton1_Click()
If TextBox1 = Cells(n, 2) Then
MsgBox "正解"
n = n + 1
Label1.Caption = Cells(n, 1)
TextBox1 = ""
Else
MsgBox "不正解"
End If
End Sub

この回答は投票によってベストアンサーに選ばれました!

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる