質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.65%

VBA タイマー機能をつける

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 17K+

IkumiFukiishi

score 11

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

これを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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

+3

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()
    '↓カウントをラベル7に表示しているだけです
    Label7.Caption = iCounter
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/01/18 10:15

    上記のコードでタイマーイベントを発生させることができました.ありがとうございます.
    コードの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

    キャンセル

  • 2016/01/18 10:46

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

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

    キャンセル

  • 2016/01/18 10:57

    できました!!!
    ありがとうございます.

    キャンセル

+1

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

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

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

End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/01/14 17:11

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

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

    キャンセル

  • 2016/01/17 10:23

    横からすみません。

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

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

    キャンセル

  • 2016/01/18 09:31

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.65%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る