|
▼foo さん:
こんな方法で試してみてください。
新規ブックで試してみてください。
標準モジュール(Module1)に
'===============================================================
Public flag As Boolean
'================================================================
Sub test()
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime '(当然実際はここでもっと違う処理を行う)
End Sub
'======================================================================
Sub main()
flag = True
Call mc_schedule(True, -1, [TimeValue("00:00:00.60")], "test")
' ↑これ以下の短い間隔では駄目でした
' 駄目というのは、制御がExcelに戻らないのでxボタンが押せない
End Sub
'======================================================================
Sub subproc()
'解除
Call mc_schedule(False)
End Sub
別の標準モジュール(Module2)に
'=====================================================================
'スケジュール管理サブルーチン
Option Explicit
Private exetm As Variant '次の実行時刻
Private repcnt As Long '繰り返し回数
Private c_cnt As Long '現在の回数
Private reptm As Variant '実行間隔時間
Private prcnm As String '実行プロシジャー名
'========================================================================
Sub mc_schedule(ByVal on_off As Boolean, Optional ByVal rep_cnt As Long = 0, _
Optional ByVal rep_time As Variant = 0, Optional ByVal proc_name As String = "")
'マクロ実行のスケジュールの設定を行う
'input : on_off --- true スケジュール設定 false---スケジュール解除
' rep_cnt 実行を繰り返す回数 -1の場合は、制限なし
' rep_time 実行間隔時間
' proc_name 実行するプロシジャー名
On Error Resume Next
If on_off = True Then
If rep_cnt > 0 Or rep_cnt = -1 Then
reptm = rep_time
repcnt = rep_cnt
c_cnt = 0
prcnm = proc_name
End If
exetm = Now() + reptm
End If
Application.OnTime EarliestTime:=exetm, Procedure:="mc_exec", Schedule:=on_off
On Error GoTo 0
End Sub
'=================================================================
Sub mc_exec()
'スケジュール設定されたプロシジャーを実行する
Dim wk As Variant
wk = Application.Run(prcnm)
If repcnt <> -1 Then c_cnt = c_cnt + 1
If c_cnt < repcnt Or repcnt = -1 Then
Call mc_schedule(True)
End If
End Sub
Thisworkbookのモジュールに
'================================================================
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If flag Then
MsgBox "End..."
subproc
End If
End Sub
として、Module1のmainを実行してみてください。
ちゃんとメッセージが表示されます。
監視間隔が遅いのは仕方がないですが、
検討してみてください。
|
|