Application.OnTime の使い方

エクセルのマクロで、過ぎた時間の背景を
グレーにする予定表を作ろうとしてます。
試しに一秒ごとにグレーにしようと以下のものを書いてみたのですが
１セルしかグレーになりません。

理想としては１秒、２秒、３秒ごとに一つずつセルを変えたいです。
range * i　で型の問題がある気がするのですが、
なにかアドバイスあればよろしくお願いします。

以下は関数のページです。

TimeValue
http://msdn.microsoft.com/library/ja/default.asp …

OnTime
http://msdn.microsoft.com/library/ja/default.asp …

----------------------------------------------------

Sub timer()
Dim range As Integer
For i = 1 To 100
range = TimeValue("0:00:01")
my_time = Now + (range * i)
Application.OnTime my_time, "setBg"
Next
End Sub


Sub setBg()
Cells(Second(Now), 1).Interior.ColorIndex = 16
End Sub

No.3 ベストアンサー 回答者： redfox63 回答日時： 2008/03/23 12:23

1分ごとに処理したいのであれば

Sub Timerの中のループは mのみで良いように思います
余分な hやsでループしてタイマーをセットするのは資源の無駄遣いです

1分ごとにプロシージャを呼び出せれば良いのですから
dim mySpan(59) as Date

Sub Timer()
　　dim span as date, n as integer
　　span = Now
　　for n = 0 to 59
　　　　mySpan(n) = span
　　　　Application.onTime span, "setBg"
　　　　span = DateAdd( "n", 1, sapn )
　　next
End Sub

Sub setBg()
　　dim m as integer, h as inetegr, span as range
　　m = Minute( Now )
　　h = hour( Now )
　　If m >= 3 Then
　　　　Cells( m - 1, h + 1).Interior.ColorIndex = 16
　　Else
　　　　Cells( m + 59, h + 1 ).Interior.ColorIndex = 16
　　End If
　　' タイマーの更新
　　Application.onTime mySapn( m ), "setBg",,False
　　mySpan( m ) = DateAdd( "h", 1, mySpan(m) )
　　Application.onTime mySapn( m ), "setBg"
End Sub

ブックを読み込んだ時点で自動実行させたいなら
標準モジュールに Sub Auto_Open()
ThisWorkbookの Sub Workbook_Open()
のどちらかに 開始時に行う処理を呼び出すようにすれば良いですよ

この回答へのお礼

何度も教えていただき とても勉強になりました。
また一つプログラミングの面白さを体験できました。
たぶんこんなスケジュール帳を使いたい人はいないと思いますが、
興味あれば使ってみてください（笑）　 回答ありがとうございました。

お礼日時：2008/03/25 14:11

No.2 回答者： imogasi 回答日時： 2008/03/22 14:28

私には、わからないとことだらけですが

私がやって見ると
下記は１秒ごとにＡ１セルから下方向に黄色をつける（20秒）内容です。
Public n
Sub Timer()
n = 0
range("A:A").Clear
For i = 1 To 20
my_time = Now + TimeValue("0:0:01") * i
Application.OnTime my_time, "setBg"
Next i
End Sub
Sub SetBg()
n = n + 1
Cells(n, 1).Interior.ColorIndex = 6
End Sub
でうまくいくようです。
その
Ｆｏｒ　Ｎｅｘｔループの実行は、実時刻の経過と関係なく実行されるようです。その仕組み理解不足。
ＶＢＡは自分の世界で早々と実行。システムに時間が来たら実行してよね、と言いぱっなしのようなイメージかな。
ですからFor i = 1 To 100だとSub SetBg()の実行では、iは１０１で１００回繰り返されるようです。
というのも、私は初めはiがSub SetBg()でも使えないか、とやってみたが、私の理解不足した。質問者もそれはわかっていたのかもしれないが。
それで上記のようにしてみました。
ーー
ただ、ループの各回ごとの実行を実時間の経過に強制的にあわせて、Sub SetBg()に飛ばせる方法は無いのかと思うが、そういう仕組みはＦorNextや普通のＶＢＡでは無理のようだ。
ーー
＃１のご回答ではその点Cells( Second(Now)+1,1).で（Ｎｏｗを使って）解決しておられる。（質問者の質問文でもその路線ですが）。
ただしSub Timer()では名前がTimerだからか、エラーになりませんか。Sub TimerＡ()にしたらＯＫですが。

No.1 回答者： redfox63 回答日時： 2008/03/22 13:58

rangeをDate型にして forループは1と60で良いように思います

Sub Timer()
　　dim range as Date, my_time as Date, i as Integer
　　range = timevalue("0:0:1")
　　for i = 1 to 60
　　　　my_time = Now + range * i
　　　　Application.OnTime my_time, "setBg"
　　next
End Sub

Sub SetBg()
　　' Secondの戻り値が0から59なので +1をして補正する
　　Cells( Second(Now)+1,1).Interior.ColorIndex = 16
End Sub

この回答への補足

回答ありがとうございます。　出来ました^^
もしよろしければ重ねてお伺いしてもよろしいでしょうか。

１．以下のコードで一分ごとに背景が変わるようになったのですが、
もっと効率の良い方法はありますか？？
マクロを始める時に 60 x 60 x 24 の演算をしてしまうので。
JavaScript の setInterval のようなものがあったら良いなと思いました。

以下のは、セル A1 から X1 に０時から２３時と入れて
縦の番号がそのまま minutes になるものです。
０分は行６０、１分は行６１になるんですけども。
時間が過ぎる速さを実感したいと思いまして。

２．また、このエクセルファイルを開くと同時に
マクロを実行することは可能でしょうか？？

解る範囲で教えて頂けると助かります。
------------------------------------------------------
Sub timer()
Call initialize
For h = 0 To 23
For m = 0 To 59
For S = 0 To 59
Application.OnTime Now + TimeValue(h & ":" & m & ":" & S), "setBg"
Next
Next
Next
End Sub


Sub setBg()
If Second(Now) = 0 Then
If Minute(Now) >= 3 Then
Cells(Minute(Now) - 1, Hour(Now) + 1).Interior.ColorIndex = 16
Else
Cells(Minute(Now) + 59, Hour(Now)).Interior.ColorIndex = 16
End If
End If
End Sub


Sub initialize()
' set previous hour
If Hour(Now) <> 0 Then
For h = 0 To Hour(Now) - 1
For m = 2 To 61
Cells(m, h + 1).Interior.ColorIndex = 16
Next
Next
End If

' set this hour
If Minute(Now) >= 3 Then
For m = 2 To Minute(Now) - 1
Cells(m, Hour(Now) + 1).Interior.ColorIndex = 16
Next
End If
End Sub

補足日時：2008/03/22 15:04