VBA 繰り返し。。。

質問

VBAで
Sub test1()
End Sub
と
Sub test2()
End Sub
の2つがあるとします。（上記中身はありません）
この2つを例えば5分ごとに繰り返し実行させるには、どうすればいいでしょうか？
最初は、開始ボタンを押すことにより始まり、停止ボタンを押せば
停止させたいと思っています。
よろしくお願いします。

回答No.1

TYWalker · ベストアンサー

他に何もしなくていいんだったらこれでいくようです。
実行を中止するには Break（Ctrlを押しながらPause/Breakを押す）で止まります。

Sub test1()
Application.StatusBar = "test1 started" 'テスト用にステータスバーを書き換えています。
wait10
test2
End Sub

Sub test2()
Application.StatusBar = "test2 started"
wait10
test1
End Sub

Sub wait10()
'10秒待つサブルーチン、Waitメソッドのヘルプの丸写しです
'5分にしたいなら、newSecondではなくnewMinuteに5を足せばいいと思います。
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
End Sub

補足

実行を停止するには、breakではなく
ボタンで行いたいのですが、どの様にすればいいですか？
すんなり停止させたいのですが。。。

回答No.3

うぃず（@Wizard_Zero）

あえて茨の道を行ってみる。
Windowsのタイマー機能を使うことでPCとExcelにできるだけ負荷を掛けない手法。

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

Private hTimer As Long
Private dtNext As Date
Private strMethod As String

' １秒ごとに呼び出されるコールバック関数
Private Sub TimerProc(hwnd As Long, uMsg As Long, idEvent As Long, dwTime As Long)

' 指定時刻を経過したら
If Now > dtNext Then

' メソッド名で分岐
Select Case strMethod
Case "test1": Call test1
Case "test2": Call test2
End Select

' ５分後を記憶
dtNext = DateAdd("n", 5, Now)
End If
End Sub

' タイマー開始（開始ボタンのクリックイベント内でこれを呼び出す）
Public Sub StartTimer()

' すでにタイマーが稼働していたら何もしない
If hTimer <> 0 Then Exit Sub

' タイマースタート、同時に５分後の時刻と最初に呼び出すメソッド名を記憶
hTimer = SetTimer(0, 0, 1000, AddressOf TimerProc)
dtNext = DateAdd("n", 5, Now)
strMethod = "test1"
End Sub

' タイマー停止（停止ボタンのクリックイベント内でこれを呼び出す）
Public Sub StopTimer()

' すでにタイマーが停止していたら何もしない
If hTimer = 0 Then Exit Sub

' タイマー停止
Call KillTimer(0, hTimer)
hTimer = 0

End Sub

Private Sub test1()
Debug.Print "test1 Called"

strMethod = "test2" ' 次回はtest2を呼ぶ
End Sub

Private Sub test2()
Debug.Print "test2 Called"

strMethod = "test1" ' 次回はtest1を呼ぶ
End Sub

お礼

高度でよくわかりませんが、見ながら色々やってみたいと思います。
Windowsのタイマー機能を使う方法もあったのですね。
ありがとうございます。

回答No.2

kimic_3

flg as Boolean

Sub 開始ボタン()
　flg = true
　s = Now

　Do While flg
DoEvents

if s - Now > 「５分」Then
test1()
test2()
s = Now
End If

Wend
End Sub

Sub 停止ボタン()
flg = False
End Sub

適当に書くとこんな感じかな？

キモは、無限ループと DoEvents
後、無限ループを脱出するフラグ

お礼

なんとなくわかった気がします。
テストしてみます。
ありがとうございます。