VBA タイマー機能をつける

Question

文字の意味とフォントの色が一致しないようなテスト（ストループカラーワードテスト；例 あかという文字が緑色で書かれている）を作りたいです．
現在，問題は画像で表示して，その回答が下に出るように以下のコードを書きました．
（回答が正解であれば右クリック，間違いであれば左クリックを押して，どちらを押しても次の問題がでるようにしています．問題の画像と表示される回答は関連性はなく，どちらもただランダムに表示されるようにしています．）

これを5秒毎に問題と下の回答が変わるかつクリックすると問題が変わるというコードに変えたいのですが，タイマーのコードを書いても結局マウスをクリックしないとイベントが起こらず，困っています．
下のコードにはタイマーのコードは入っていません．
どのように変えればよいかアドバイスをお願いいたします．
また違う方法があればそちらも教えていただきたいです．

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Select Case Button
Case 1

Dim strPicture1(9) As String
strPicture1(0) = "C:\Users\Desktop\VBA\rr.jpg"
strPicture1(1) = "C:\Users\Desktop\VBA\rg.jpg"
strPicture1(2) = "C:\Users\Desktop\VBA\rb.jpg"
strPicture1(3) = "C:\Users\Desktop\VBA\gr.jpg"
strPicture1(4) = "C:\Users\Desktop\VBA\gb.jpg"
strPicture1(5) = "C:\Users\Desktop\VBA\gg.jpg"
strPicture1(6) = "C:\Users\Desktop\VBA\bb.jpg"
strPicture1(7) = "C:\Users\Desktop\VBA\br.jpg"
strPicture1(8) = "C:\Users\Desktop\VBA\bg.jpg"

p = strPicture1(Int(Rnd() * 9))
Image1.Picture = LoadPicture(p)

Dim a As Variant
a = Array("あか", "あお", "みどり")
L = a(Int(Rnd() * 3))
Label7.Visible = True
Label8.Visible = False
Label7.Caption = L
Label7.Font.Size = 100

Case 2
Dim strPicture2(9) As String
strPicture2(0) = "C:\Users\Desktop\VBA\rr.jpg"
strPicture2(1) = "C:\Users\Desktop\VBA\rg.jpg"
strPicture2(2) = "C:\Users\Desktop\VBA\rb.jpg"
strPicture2(3) = "C:\Users\Desktop\VBA\gr.jpg"
strPicture2(4) = "C:\Users\Desktop\VBA\gb.jpg"
strPicture2(5) = "C:\Users\Desktop\VBA\gg.jpg"
strPicture2(6) = "C:\Users\Desktop\VBA\bb.jpg"
strPicture2(7) = "C:\Users\Desktop\VBA\br.jpg"
strPicture2(8) = "C:\Users\Desktop\VBA\bg.jpg"

q = strPicture2(Int(Rnd() * 9))
Image1.Picture = LoadPicture(q)

Dim b As Variant
b = Array("あか", "あお", "みどり")
M = b(Int(Rnd() * 3))
Label7.Visible = False
Label8.Visible = True
Label8.Caption = M
Label8.Font.Size = 100
End Select

End Sub

Answer 1

VBAにはVBのようなタイマーコントロールはありませんが、その代替え策は「VBA タイマー処理」などでググればいくつか出てくると思います。

自分が使ったことがある方法として、タイマーイベントを繰り返し発生させるやり方を紹介します。

Private pblnFlg As Boolean  'タイマー終了判定用
Sub Macro1()
    '初期化
    Cells(1, 2) = 0
    pblnFlg = True
    
    '初回タイマーセット
    subTimerSet
End Sub

Sub subTimerSet()
    If pblnFlg = True Then
        '現在のシステム時刻から5秒後にsubChangeを実行するようタイマーイベントをセット
        Application.OnTime TimeValue(Now + TimeValue("00:00:05")), "subChange"
    End If
End Sub

Sub subChange()
    'メイン処理 （セル値の加算）
    Cells(1, 2) = Cells(1, 2) + 1

    'タイマー終了判定
    If Cells(1, 2) < 10 Then
        'セル値が10未満なら次回もタイマー有効
        pblnFlg = True
    Else
        'セル値が10以上になったら次回のタイマー無効
        pblnFlg = False
    End If
    
    '次回用タイマーセット
    subTimerSet
    
End Sub

Macro1を実行すると5秒後にsubChangeが実行されるようタイマーがセットされます。
subChangeでは目的の処理（このサンプルではセル値の加算）を行った後にさらに5秒後のタイマーをセットしています。

現在MouseUp時に行っている画像やラベルの変更処理をメソッド化し、タイマーイベントとMouseUpイベントで同じ処理を呼び出すようにすれば目的の動作になると思います。

---

上記サンプルはユーザーフォームを使わずExcelシート上で動作するものでしたが、フォーム表示中は動作しないようでした。
Microsoftの技術情報にAPIを利用する方法がありましたので、別案として追記させていただきます。

(参考サイト)
https://support.microsoft.com/ja-jp/kb/180736

①「モジュールの追加」で標準モジュールを作成し、以下コードを追加する

Declare Function SetTimer Lib "user32" _
      (ByVal hwnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
      (ByVal hwnd As Long, _
      ByVal nIDEvent As Long) As Long

Global iCounter As Integer

Sub TimerProc(ByVal hwnd As Long, _
               ByVal uMsg As Long, _
               ByVal idEvent As Long, _
               ByVal dwTime As Long)

    'ここにタイマーイベントで行いたい処理を記述する
    iCounter = iCounter + 1
    UserForm1.colorword
End Sub

②ユーザーフォーム(UserForm1)にCommandButton1とLabel7を配置し、タイマーの開始/終了を制御する（以下ではCommandButton1クリックで開始/停止）

Dim lngTimerID As Long
Dim BlnTimer As Boolean

Private Sub Form_Load()
   BlnTimer = False
   Command1.Caption = "Start Timer"
End Sub

Private Sub CommandButton1_Click()
   If BlnTimer = False Then
      'Startボタンの時にクリックした場合
      'タイマー開始(5000ミリ秒=5秒)
      lngTimerID = SetTimer(0, 0, 5000, AddressOf TimerProc)
      If lngTimerID = 0 Then
          MsgBox "タイマーを開始できませんでした。"
          Exit Sub
      End If
      BlnTimer = True
      
      'Stopボタンに変更
      CommandButton1.Caption = "Stop Timer"
   Else
      'Stopボタンの時にクリックした場合
      'タイマー停止
      lngTimerID = KillTimer(0, lngTimerID)
      If lngTimerID = 0 Then
          MsgBox "タイマーを停止できませんでした。"
      End If
      BlnTimer = False
      
      'Startボタンに変更
      CommandButton1.Caption = "Start Timer"
    End If
End Sub

'↓標準モジュールから呼び出すためPublic関数にしています。
Public Sub colorword()
    '↓カウントをラベル７に表示しているだけです
    Label7.Caption = iCounter
End Sub

Comments

[IkumiFukiishi]

回答ありがとうございます．
>>現在MouseUp時に行っている画像やラベルの変更処理をメソッド化し、

メソッド化とはなんでしょうか．

[IkumiFukiishi]

こういうことでしょうか？？

Private Sub colorword()

Dim strPicture1(9) As String
strPicture1(0) = "C:\Users\Desktop\VBA\rr.jpg"
strPicture1(1) = "C:\Users\Desktop\VBA\rg.jpg"
strPicture1(2) = "C:\Users\Desktop\VBA\rb.jpg"
strPicture1(3) = "C:\Users\Desktop\VBA\gr.jpg"
strPicture1(4) = "C:\Users\Desktop\VBA\gb.jpg"
strPicture1(5) = "C:\Users\Desktop\VBA\gg.jpg"
strPicture1(6) = "C:\Users\Desktop\VBA\bb.jpg"
strPicture1(7) = "C:\Users\Desktop\VBA\br.jpg"
strPicture1(8) = "C:\Users\Desktop\VBA\bg.jpg"

p = strPicture1(Int(Rnd() * 9))
Image1.picture = LoadPicture(p)

Dim a As Variant
a = Array("あか", "あお", "みどり")
L = a(Int(Rnd() * 3))

Label7.Caption = L
Label7.Font.Size = 100

End Sub
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Select Case Button
Case 1
Call colorword
Case 2
Call colorword
End Select

End Sub

[jawa]

左右ボタンの処理が同じでよいのであれば、メソッド化はそれで大丈夫です。
処理を分ける必要がある場合はcolorword関数に引数を用意し、Buttonの値を渡してあげて、中で処理分岐してあげてください。

あと上記はMouseUpイベントしか実装できていないので、前述のタイマーイベントも作成してcolorword関数を呼び出すようにすればいいと思います。
※タイマーイベントは何も考えないと無限に処理を繰り返すことになるので、終了させる方法（例えば10回処理したら次回はタイマーセットしない等）もあわせて検討し、実装してください。

[IkumiFukiishi]

タイマーが働いていないのか，うんともすんともいいません．．．．

Private pblnFlg As Boolean 'タイマー終了判定用
Sub Macro1()
'初期化
Cells(1, 2) = 0
pblnFlg = True

'初回タイマーセット
subTimerSet
End Sub

Sub subTimerSet()
If pblnFlg = True Then
'現在のシステム時刻から2秒後にsubChangeを実行するようタイマーイベントをセット
Application.OnTime TimeValue(Now + TimeValue("00:00:02")), "colorword()"
End If
End Sub

Private Sub colorword()
Dim strPicture1(9) As String
strPicture1(0) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\rr.jpg"
strPicture1(1) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\rg.jpg"
strPicture1(2) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\rb.jpg"
strPicture1(3) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\gr.jpg"
strPicture1(4) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\gb.jpg"
strPicture1(5) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\gg.jpg"
strPicture1(6) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\bb.jpg"
strPicture1(7) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\br.jpg"
strPicture1(8) = "C:\Users\Ikumi Fukiishi\Desktop\VBA\bg.jpg"
p = strPicture1(Int(Rnd() * 9))
Image1.picture = LoadPicture(p)
Dim a As Variant
a = Array("あか", "あお", "みどり")
L = a(Int(Rnd() * 3))
Label7.Caption = L
Label7.Font.Size = 100

'タイマー終了判定
If Cells(1, 2) < 10 Then
'セル値が10未満なら次回もタイマー有効
pblnFlg = True
Else
'セル値が10以上になったら次回のタイマー無効
pblnFlg = False
End If
'次回用タイマーセット
subTimerSet
End Sub

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Select Case Button
Case 1
Call colorword
Case 2
Call colorword
End Select
End Sub

[jawa]

ユーザーフォーム上での動作だったのですね。
確かにフォーム上から利用するとタイマーセットでエラーにならないのに時間になっても処理は開始されないようです。

代案として、APIを利用した方法を追記させていただきました。
参考になれば幸いです。

[IkumiFukiishi]

ありがとうございます．
コマンドボタンは表示されるのでタイマーは動いているようですが，時間が表示されず，エクセルが自動でシャットアウトしてしまい動かなくなってしまいました．．．笑
一定時間ごとに動かすもしくはクリックしてから一定時間たつと次の問題を表示するというのは無理なのでしょうか．．．
タイマー機能があるとのことでしたので，VBでもやってみようと思います．

[jawa]

先に提示したOnTImeでは次回の実行時刻を設定するため、処理を行うたびに「次は現在時刻から5秒後に処理する」という設定を毎回行っていました。

別案として提示したAPIのタイマーについては、SetTimerで発生間隔を指定しています。
このため、一度SetTimerをしておけば、KillTimerされるまで自動で繰り返しTimerProc処理を実行してくれます。

タイマー処理中にフォーム名やコントロール名間違いなどでエラーが発生すると、Excelが強制終了してしまうようです。
いま一度コード誤りがないか確認し、念のため保存をしてから実行することをお勧めします。

私の環境（Windows7/Excel2010）では問題なくタイマーの動作を確認できましたので、がんばってみてください。

[IkumiFukiishi]

ありがとうございます。
やってみます！！

[IkumiFukiishi]

ラベルに１という文字が表示されましたが，またエクセルが再起動になってしまいました．

[jawa]

Excelが強制終了してしまうのは、（メモリ不足とかハード的な要因でなければ）おそらく処理中のどこかでエラーが発生しているからではないかと思います。

デバッグ実行という機能はご存知でしょうか？
処理を１ステップずつ実行したり、ソースコード内の任意の位置にブレイクポイントを設定しておくことで、その処理を通過する際に一時中断することができます。

関数の先頭付近にブレークポイントを設定(F9)しておき、F8でステップ実行してエラーの箇所を特定してみてください。

目安として、起動直後にエラーとなるのであればForm_Load、ボタン押下直後であればボタンのクリックイベント、タイマー開始5秒後のエラー発生であればTimerProcが怪しいので、そのあたりにブレイクポイントを設定してエラーの発生箇所を探してみてください。

[IkumiFukiishi]

上記のコードでタイマーイベントを発生させることができました．ありがとうございます．
コードのuserformの部分が違っていたようでした．
Label7に数字のカウンターは表示されるようになりましたが，これを自分の書いた文字をランダムに表示させるコードに書き換えると表示されなくなりました．
強制終了しないのでコードが間違っているわけではないようなのですが，，，

以下コードです．
標準モジュール
Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)

'ここにタイマーイベントで行いたい処理を記述する

Dim a As Variant
a = Array("あか", "あお", "みどり")
L = a(Int(Rnd() * 3))
random1.colorword

End Sub

ユーザーフォーム
Dim lngTimerID As Long
Dim BlnTimer As Boolean

Private Sub Form_Load()
BlnTimer = False
Command1.Caption = "Start Timer"
End Sub

Private Sub CommandButton1_Click()
If BlnTimer = False Then
'Startボタンの時にクリックした場合
'タイマー開始(5000ミリ秒=5秒)
lngTimerID = SetTimer(0, 0, 2000, AddressOf TimerProc)
If lngTimerID = 0 Then
MsgBox "タイマーを開始できませんでした。"
Exit Sub
End If
BlnTimer = True

'Stopボタンに変更
CommandButton1.Caption = "Stop Timer"
Else
'Stopボタンの時にクリックした場合
'タイマー停止
lngTimerID = KillTimer(0, lngTimerID)
If lngTimerID = 0 Then
MsgBox "タイマーを停止できませんでした。"
End If
BlnTimer = False

'Startボタンに変更
CommandButton1.Caption = "Start Timer"
End If
End Sub

'↓標準モジュールから呼び出すためPublic関数にしています。
Public Sub colorword()
Label7.Caption = L

End Sub

[jawa]

だいぶ目的の動作に近づいてきましたね。
表示されなくなってしまったのは、LがPublicな変数ではないからだと思います。

以前作成したcolorwordメソッドは乱数を生成し画面に反映させる機能として作成しましたよね。
今回、乱数生成をTimerProc内で行うように変更してしまったようですが、TimerProcは単純に実行したい処理(colorword)を呼び出すだけにしておき、colorwordメソッドは以前のようにやりたい処理をまとめた機能にしておけばいいと思いますよ。

[IkumiFukiishi]

できました！！！
ありがとうございます．

Answer 2

5秒毎にタイマーイベントが発生するようにしてタイマーイベントに処理を記述すればよいのでは?
クリックしたときに一旦TimerIntervalを0にしてから5000を設定する
後はタイマーイベント処理中はフオームが閉じられないようにするなどの工夫も必要

'5秒ごにタイマーイベントが発生される
Me.TimerInterval = 5000

'タイマーイベント
Private Sub Form_Timer()
'ここに処理を記述

End Sub

Comments

[IkumiFukiishi]

回答ありがとうございます．

>>クリックしたときに一旦TimerIntervalを0にしてから5000を設定する
というのはどういう処理でしょうか？？

[thom.jp]

横からすみません。

「UserForm_MouseUp」というプロシージャ名からおそらくExcel VBAをお使いかと思われます。

TimerIntervalはAccessのフォームにあるプロパティで、Excel VBAのフォームでは使えません。

[IkumiFukiishi]

はいVBAを使っています．
ありがとうございます．