2019/11/28
2024/01/30 OnTimeでのミリ秒制御不可を修正

再計算されたか否かのチェックをイベントで取得

• ０．はじめに
• １．１つのセルに注目し、値に変化があったら点滅させる
• ２．早い点滅をさせる
• ３．待ち時間を制御する別の方法
• ４．待ち時間の間もマウスやキーが使えるようにするには
• ５．時間制御のまとめ
• ６．複数のセルに注目して、変化があったセルを点滅させる
• 　6-1．待ち時間調整方式
• 　6-2．実施時刻予約方式
• 　　6-2-1．プロシージャの引数に数値を渡す場合
• 　　6-2-2．プロシージャの引数に文字列を渡す場合
• 　　6-2-3．プロシージャの引数をカッコ付きで渡す手法

０．はじめに

証券取引所には、各社の株価が並んでいて値が変化すると点滅する株価ボードがあります。

変化があったり、ある特定の時間になったりした時というのは、作業者や管理者としては何か対応するタイミングである事が多いと思います。そんな時、表示色が変わったり点滅したり、あるいは音が鳴ったりして知らせてくれるアプリというのは助かります。
今回は、そんなアプリに挑戦したいと思います。

１．１つのセルに注目し、値に変化があったら点滅させる

最初からズラリとならんだ電光掲示板は大変なので、「１セル電光掲示板」からスタートしましょう。まず、A1セルに「=D1」の様に、計算式を入れて下さい。


次に、下のプログラムをシートマクロとして記述してください。１つ前のセル値を代入しておく変数（a_cell）は、プロシージャの外の宣言部に記載します。

1. Dim a_cell As Variant
3. Private Sub Worksheet_Calculate()
4. 　If a_cell = "" Then
5. 　　a_cell = Cells(1,1).Value 　　　　　　　 'セルに初期値が入っていない時に代入
6. 　　Exit Sub　　　　　　　　　　　　　　　　　 '１回目だけは、そのまま抜ける
7. 　End If
9. 　If a_cell <> Cells(1, 1).Value Then　　 'セル値が変化した時のみ動作
10. 　　Cells(1, 1).Interior.Pattern = xlNone　　 'セル色なし
11. 　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
12. 　　Cells(1, 1).Interior.Color = RGB(256, 0, 0)　　　 'セル色赤
13. 　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
14. 　　Cells(1, 1).Interior.Pattern = xlNone　　 'セル色なし
15. 　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
16. 　　Cells(1, 1).Interior.Color = RGB(256, 0, 0)　　　 'セル色赤
17. 　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
18. 　　Cells(1, 1).Interior.Pattern = xlNone　　 'セル色なし
20. 　　a_cell = Cells(1,1).Value　　　　 'セル値を更新
21. 　End If
22. End Sub

マクロを記述したら、ワークシートの「D1」セルを色々な値に変更してみて下さい。１回目の変更時は無反応ですが、その次からは「A1」セルが赤く点滅するはずです。

なお、動作後に「まずセル色なし」を設定した（コードの10行目）のは、安定して赤点滅させるためです。最初に「セル色赤」を設定すると、動作させるタイミング次第では赤になっている時間が一定になりません。

２．早い点滅をさせる

上記のプログラムでは、時間待ちにはApplication.Waitメソッドを使用しているため、基本的には１秒単位での制御になります。これをもっと早く点滅させよう（例えば0.5秒単位）として以下の様に書き換えると、「型が一致しません」と実行時エラーが発生します。

11. 　　Application.Wait (Now + TimeValue("0:00:00.50"))　　　 '←これではエラー発生！

１秒未満の制御方法については、丸カッコ（）では無く、角カッコ［］を使って以下のように、「now()」＋「秒」で指定します。ちなみに「86,400,000」という数字は、１日当たりのミリ秒で「24hr x 60分 x 60秒 x　1000ミリ秒」となります。

1. 　　Application.Wait [Now() + "0:00:00.500"]
2. 　　または
3. 　　Application.Wait [Now()] + 500/86400000]

ここで現時刻を表す「Now」は、１秒単位の場合には「Now」でも「Now()」でも（丸カッコがあってもなくても）問題無いのですが、ミリ秒の場合は丸カッコのある「Now()」にする必要があります。
なお、この角カッコ［］はEvaluateメソッドの代わりとなるもので、Evaluateとは「引数（文字列）をオブジェクトまたは値に変換もの」です。EvaluateはApplicationオブジェクトのメソッドなので、VBAとして「Application.Evaluate("now()")」と「[now()]」を比較してみると同一の値が得られることが分かります。

という事は、
・Now()はもともと1秒未満の時刻を持っているが、関数として出力する時には秒単位に丸める。
・Application.EvaluateメソッドでNow()の元のデータを見に行くと、元の１秒未満の時刻まで見られる。
ということなのかもしれません。
しかし、この手法は色々なサイトで紹介されているのですが、（Microsoftの）公式な説明は確認できていないので、アプリとして長期間・広範囲で使用する場合には、別な方法を使った方が良いのかもしれません。

３．待ち時間を制御する別の方法

また以下のように、Do～Loop や While～Wend で、指定の時間が来るまで回しておく、という方法もあります。

1. Dim a_cell As Variant
3. Private Sub Worksheet_Calculate()
4. 　If a_cell = "" Then
5. 　　a_cell = Cells(1,1).Value
6. 　　Exit Sub
7. 　End If
9. 　If a_cell <> Cells(1, 1).Value Then
10. 　　Cells(1, 1).Interior.Pattern = xlNone
11. 　　call Mati
12. 　　Cells(1, 1).Interior.Color = RGB(256, 0, 0)
13. 　　call Mati
14. 　　Cells(1, 1).Interior.Pattern = xlNone
15. 　　call Mati
16. 　　Cells(1, 1).Interior.Color = RGB(256, 0, 0)
17. 　　call Mati
18. 　　Cells(1, 1).Interior.Pattern = xlNone
20. 　　a_cell = Cells(1,1).Value
21. 　End If
22. End Sub
24. Sub Mati()
25. 　Dim n As Date
26. 　n = Now()
27. 　Do While (n + "00:00:01") > Now()
28. 　Loop
29. End Sub

「Do While～Loop」の繰り返しが面倒なので外に出しましたが、 同じように動きます。
なお、26行目で「Now()を変数nに代入」しているのは、その時点での時刻を取得するためであり、ボーッとして以下のようなコードにすると無限ループになります。そういった場合に備え「プログラムを実行する前に、必ずファイル保存を」しましょう。

1. Sub Mati()
2. 　Dim n As Date
3. 　n = Now()
4. 　Do While (Now() + "00:00:01") > Now()　　　 '←こんなミスに充分注意を！
5. 　Loop
6. End Sub

尚、上の例は１秒単位の制御ですが、１秒未満で制御しようとした場合には「Now()」は使えません。Now()はDate型で最小で1秒の単位までしか入りません。１秒未満を出そうとすれば「Timer() 」を使用する必要があります。型は型はSingleですが、日付の部分は無くて時刻部分のみです。また、Double型に代入すると、その分精度が上がったように見えます。
例えば、0.5秒置きに点滅させようとすれば、以下の様になります。

24. Sub Mati()
25. 　Dim n As Single
26. 　n = Timer()
27. 　Do While (n + 0.5) > Timer()
28. 　Loop
29. End Sub

また、Windows APIのSleep関数を使って、ミリ秒単位の指定時間だけ処理を止めることができます。以下の様に先頭で宣言が必要となります（16ビットCPUでは、kernel16　になります）。

1. Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
3. Private Sub Worksheet_Calculate()
4. 　　　・・・
5. 　　sleep 500　　　 '←「500ミリ秒」という意味
6. 　　　・・・
7. End Sub

４．待ち時間の間もマウスやキーが使えるようにするには

但し、いずれのコードも、待ち時間の間はマウスクリックやキー操作は出来ません。ただ、「Do While～Loop」の場合には以下のように「DoEvents」をDo～Loopの間に入れることで、回している間は制御をO/Sに渡すために、マウスやキーが復活します。
２つ上のコードと比較してみて下さい。

24. Sub Mati()
25. 　Dim n As Single
26. 　n = Timer()
27. 　Do While (n + 0.5) > Timer()
28. 　　DoEvents　　　　　　　　 '←Do～Loopで回っている間は、制御をO/Sに渡す
29. 　Loop
30. End Sub

WaitもSleepもDo～Loopも、「待ったり」「クルクル回したり」することで、次に進む時間を調整しているのですが、「OnTime」というメッソドは、それらとは少し違って「実行の予約をする」ものです。
以下の「Worksheet_Calculate」イベントプロシージャは、ワークシートマクロに、その下の呼び出されるプロシージャは標準モジュールに記述して下さい。

1. Dim a_cell As Variant
3. Private Sub Worksheet_Calculate()
4. 　If a_cell = "" Then
5. 　　a_cell = Cells(1,1).Value
6. 　　Exit Sub
7. 　End If
9. 　If a_cell <> Cells(1, 1).Value Then
10. 　　Application.OnTime Now() + TimeValue("00:00:00") , "White_cell"
11. 　　Application.OnTime Now() + TimeValue("00:00:01") , "Red_cell"
12. 　　Application.OnTime Now() + TimeValue("00:00:02") , "White_cell"
13. 　　Application.OnTime Now() + TimeValue("00:00:03") , "Red_cell"
14. 　　Application.OnTime Now() + TimeValue("00:00:04") , "White_cell"
16. 　　a_cell = Cells(1,1).Value
17. 　End If
18. End Sub

（呼び出されるプロシージャ（Red_cell、White_cell）は「標準モジュール」へ記述）

1. Sub Red_cell()
2. 　Cells(1, 1).Interior.Color = RGB(256, 0, 0)
3. End Sub
5. Sub White_cell()
6. 　Cells(1, 1).Interior.Pattern = xlNone
7. End Sub

実行してみると点滅はするのですが、点滅間隔が不安定な感じです。１秒間隔での予約は非現実的なのかもしれません。 また、「Application.OnTime」は１秒単位でしか実行指令が出来ず、１秒未満点滅はこの方法では不可能と言われています。

しかし「早い点滅をさせる」で説明した角カッコ［］（Evaluateメソッド）を使用して以下のようなコードにすると、ミリ秒単位の制御が可能となります。

1. Dim a_cell As Variant
3. Private Sub Worksheet_Calculate()
4. 　If a_cell = "" Then
5. 　　a_cell = Cells(1,1).Value
6. 　　Exit Sub
7. 　End If
9. 　If a_cell <> Cells(1, 1).Value Then
10. 　　Application.OnTime [Now()] + 0 / 86400000, "White_cell"
11. 　　Application.OnTime [Now()] + 200 / 86400000, "Red_cell"
12. 　　Application.OnTime [Now()] + 400 / 86400000, "White_cell"
13. 　　Application.OnTime [Now()] + 600 / 86400000, "Red_cell"
14. 　　Application.OnTime [Now()] + 800 / 86400000, "White_cell"
16. 　　a_cell = Cells(1,1).Value
17. 　End If
18. End Sub

５．時間制御のまとめ

色々なやり方が出てきましたので、ここで一度まとめておきます。


ここまで、変化があった際の動作としてセル色を変更することで点滅させていましたが、Beepなどを使って音を出すことも同じ流れでできますのでトライしてみて下さい。
但し、ユーザに伝える手段を考えた場合、ユーザPCを消音設定にしたり、デスクトップPCであったりすると音は聞こえませんし、セキュリティ関係で離席後は蓋を閉じたりスリープモード・スクリーンセーバー等で色の変化でもユーザに伝わらない事が多いと思います。一番はユーザの携帯・スマホに自動的にメールを送るのが確実かと思われます。

６．複数のセルに注目して、変化があったセルを点滅させる

ここまでは、１つのセルのみに注目し、１つのセルだけを点滅させていました。次の段階として複数のセルを注目・点滅させる様にしてみましょう。ワークシートは、このような状態です。

6-1．待ち時間調整方式

今まで見てきたように待ち時間調整には色々な手法がありますが、代表としてWaitで説明します。また、セル色を変更する工程はモジュールを管理する上で楽である別モジュール化を行います。
改造のやり方としては、For～Nextで５つのセルを順番に見ていき、保存されている１つ前の値と異なった値であれば、セル色を点滅させる、というだけです。

1. Dim a_cell() As Variant
3. Private Sub Worksheet_Calculate()
4. 　Dim Ar,i,j As Long
5. 　On Error Resume Next　　　　　　　 'エラーが出ても次へ進むことを指示
6. 　Ar = Ubound(a_cell,1)　　　　　　　 '配列の要素数を計算。空の配列だとエラーが発生
7. 　If Err.Number <> 0 Then　　　　　 'エラーだったら(Err.Number <> 0)以降を実施
8. 　　Redim a_cell(1 to 5)　　　　　　　 '配列の要素数を5に変更
9. 　　for i=1 to 5
10. 　　　a_cell(i) = Cells(i,1).Value　　　　 'セルに初期値が入っていない時に代入
11. 　　next i
12. 　　Exit Sub　　　　　　 '１回目だけは、そのまま抜ける
13. 　End If
14. 　On Error　GoTo 0　　　　　 '「エラーでも次へ進む」を停止
16. 　for j=1 to 5
17. 　　If a_cell(j) <> Cells(j, 1).Value Then　　 'セル値が変化した時のみ動作
18. 　　　Call White_cell(j,1)　　　　 'セル色なし
19. 　　　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
20. 　　　Call Red_cell(j,1)　　　　　 'セル色赤
21. 　　　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
22. 　　　Call White_cell(j,1)　　　　 'セル色なし
23. 　　　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
24. 　　　Call Red_cell(j,1)　　　　 'セル色赤
25. 　　　　Application.Wait(Now + TimeValue("0:00:01"))　　 '１秒待つ
26. 　　　Call White_cell(j,1)　　　　 'セル色なし
28. 　　　a_cell(j) = Cells(j,1).Value　　　　 'セル値を更新
29. 　　End If
30. 　next j
31. End Sub
33. Sub Red_cell(x,y)
34. 　Cells(x, y).Interior.Color = RGB(256, 0, 0)　　　 'セル色を赤に変更
35. End Sub
37. Sub White_cell(x,y)
38. 　Cells(x, y).Interior.Pattern = xlNone　　　 'セル色無しに変更
39. End Sub

D列の値を変更しA列の表示が変わると、赤く点滅したでしょうか。

上の例の中で、動的配列（ 例ではa_cell() ）に値が入っているか否かを調べる工程があります。Worksheet_Calculateイベントが発生する前に、Workbook_Openイベントや、「開始ボタン」で初期値を記録する方法も考えられます。
他のサイトでは「If Not Not 配列変数 Then～」、「APIを使用」、「If Sgn(配列変数) = 0 Then～」など、色々な手法が紹介されていますが、Sgn関数を使う方法は間違っている（判別を間違う場合がある）ようです。

6-2．実施時刻予約方式

次に、OnTimeをつかった実施時刻予約方式です。

6-2-1．プロシージャの引数に数値を渡す場合

OnTimeで実行するプロシージャの引数としては、今回はセルの位置を表す数値になります。

1. Dim a_cell() As Variant
3. Private Sub Worksheet_Calculate()
4. 　Dim Ar,i,j As Long
5. 　On Error Resume Next　　　　 'エラーが出ても次へ進むことを指示
6. 　Ar = Ubound(a_cell,1)　　　　 '配列のサイズを計算。空の配列だとエラーが発生
7. 　If Err.Number <> 0 Then　　 'エラーだったら(Err.Number <> 0)以降を実施
8. 　　Redim a_cell(1 to 5)　　　 '配列の大きさを5に変更
9. 　　for i=1 to 5
10. 　　　a_cell(i) = Cells(i,1).Value　　　　 'セルに初期値が入っていない時に代入
11. 　　next i
12. 　　Exit Sub　　　　 '１回目だけは、そのまま抜ける
13. 　End If
14. 　On Error　GoTo 0　　　　　　　　　　　 '「エラーでも次へ進む」を停止
16. 　for j=1 to 5
17. 　　If a_cell(j) <> Cells(j, 1).Value Then　　　　　 'セル値が変化した時のみ動作
18. 　　　　Application.OnTime Now() + TimeValue("0:00:01") , " ' White_cell " & j & ", " & 1 & " ' "
19. 　　　　Application.OnTime Now() + TimeValue("0:00:02") , " ' Red_cell " & j & ", " & 1 & " ' "
20. 　　　　Application.OnTime Now() + TimeValue("0:00:03") , " ' White_cell " & j & ", " & 1 & " ' "
21. 　　　　Application.OnTime Now() + TimeValue("0:00:04") , " ' Red_cell " & j & ", " & 1 & " ' "
22. 　　　　Application.OnTime Now() + TimeValue("0:00:05") , " ' White_cell " & j & ", " & 1 & " ' "
24. 　　　a_cell(j) = Cells(j,1).Value　　　　 'セル値を更新
25. 　　End If
26. 　next j
27. End Sub

以下のOnTimeによって呼び出されるプロシージャは、標準モジュールに記述する。

2. Sub Red_cell(x,y)
3. 　Sheets("Sheet1").Cells(x, y).Interior.Color = RGB(256, 0, 0)　　　 'セル色を赤に変更
4. End Sub
6. Sub White_cell(x,y)
7. 　Sheets("Sheet1").Cells(x, y).Interior.Pattern = xlNone　　　　 'セル色無しに変更
8. End Sub

ちゃんと動きましたでしょうか。このコードの中で18～22行目の「引数がある呼び出しマクロ」の記述方法が難解かと思いますので解説します。
「引数がある呼び出しプロシージャ」は、プロシージャ名と引数部分を含めて、全体を文字列としてシングルクォーテーション（'）で囲みます。文字列ですから、変数の記号（この場合はj）で渡すわけにはいかず、数値（例えば１）で渡すことになります。ですから、最終的には以下のような文字列になるようにします。

　　' White_cell 1,1 '　　

この文字列になるようにするには、と考えます。各文字列・変数を足していきます（文字列の足し算は　＆　です）。
ちなみに、プロシージャ名の後には必ずスペースを1つ空けてください。スペースを空けないと、上の例では「 ' White_cell1,1 ' 」となり、プロシージャ名が変わってしまいます。

　　" ' White_cell " ＆ 　j　 ＆ 　" , "　 ＆ 　　1　　 ＆ 　　" ' "　　

これを圧縮して書くと、「" ' White_cell " & j & ", " & 1 & " ' "」になるというわけです

6-2-2．プロシージャの引数に文字列を渡す場合

引数として文字列を渡す場合はちょっと変わります。文字列と言えばMsgBoxで文字列を表す場合、msgbox("Hello World")　などと文字列をダブルクォーテーション（"）で囲んで引数として渡しますので、例えばOnTimeを使って5秒後に、数値と文字列を引数で渡してMsgBoxで表示するプログラムを考えてみましょう。この場合の実際に渡す文字列は、

　　msg　no , word 　　　　　⇒　　　　msg 100 , "おめでとう" 　　　　　⇒　　　' msg 100 , "おめでとう" '　　

になりますので、これを変数に戻しながら割り当てます。なお、Excel VBAの中で「"（ダブルクォーテーション）」は記号になってしまいますので、文字としての「"（ダブルクォーテーション）」にするには２つ連続して記入「""」します。ですので以下のようになります。

　　" 'msg " ＆　 no　　＆　" ,"" "　＆ word ＆　" ""' "　　

これを使って、マクロを組み立てると以下のようになります。

1. Sub OnTime_msg()
2. 　Dim no As Integer
3. 　Dim word As String
5. 　no = 100
6. 　word = "おめでとう"
8. 　Application.OnTime Now() + TimeValue("0:00:05"), "　'msg " & no & ", """ & word & """ '　"
9. End Sub

以下のOnTimeによって呼び出されるプロシージャは、標準モジュールに記述する。

1. Sub msg(no, word)
2. 　MsgBox (no & "点でした" & vbCrLf & word)
3. End Sub

マクロを実行してみると、５秒後にMsgBoxが表示されましたでしょうか。

6-2-3．プロシージャの引数をカッコ付きで渡す手法

上の方で、プロシージャに渡す引数は「　' msg 100 , "おめでとう" '　」ような文字列になるようにする、と説明しました。実はカッコを使って渡す方法もあります。

　　' msg (100) , ("おめでとう") '　　

これは、通常のプロシージャを呼び出す際、Call無しで呼び出すときは「プロシージャ名　引数１　,　 引数２　」と記述しますが、「プロシージャ名（引数１）,（ 引数２）」でも呼び出せることと同じです。
ですので、すぐ上のプログラムの8行目は、以下のようにも記述できます。

8. 　Application.OnTime Now() + TimeValue("0:00:05"), "　'msg( " & no & "),( """ & word & """ )'　"

なお、Callを使って呼び出す「Call　プロシージャ名（引数１ , 引数２）」という記述を真似て、「プロシージャ名（引数１ , 引数２）」と書いても、VBAはプロシージャを見つけてくれませんので注意して下さい。