システムの時刻を利用しながら800ミリ秒毎のイベント発生 - Visual Basic - 教えて！goo

CommandButton1 を同時にクリックするコードは質問者に任せるとして・・・。
次のコードで正確に800ミリ秒単位でTextBox1に表示されます。
無限ループからの脱出はCommandButton2で・・・。
Excel、VBどちらでもOKです。

Option Explicit
Dim StopNow As Boolean

Private Sub CommandButton1_Click()
　　Dim S As Double ' Single でなく Double
　　Dim T As Double
　　Dim E As Double
　　　　
　　S = Timer
　　T = S
　　E = S + 0.8
　　Do Until StopNow
　　　　Do Until S > E
　　　　　　S = Timer
　　　　　　DoEvents
　　　　Loop
　　　　UpdateText S
　　　　DoEvents
　　　　S = T + 0.8
　　　　E = S + 0.8
　　　　T = S
　　Loop
End Sub

Private Sub UpdateText(ByVal NowTime As Single)
　　TextBox1 = NowTime
End Sub

Private Sub CommandButton2_Click()
　　StopNow = True
End Sub

通報する

ＶＢだとTimerがあり問題ないのだけど、ＶＢＡなのですね！
時間があれば作ろうと思っていたので、作ってみました。
精度がどれほどのものかわかりませんが参考にしてみて下さい。
ボタン２つにテキスト３つの画面で作ってあります。

Dim miEnd As Integer
□□開始ボタンのクリック□□
Private Sub CommandButton1_Click()
'フラグの初期化
miEnd = False
'ループ開始
Call LoopSub
End Sub
□□終了ボタンクリック□□
Private Sub CommandButton2_Click()
'ループ終了指定
miEnd = True
End Sub
□□メインループ□□
Private Sub LoopSub()
Dim lSCount1 As Long
Dim lSCount2 As Long
Dim lECount1 As Long
Dim lECount2 As Long
Dim lMiri As Long
Dim sSTime As String
'指定ミリ秒の取得
lMiri = Val(TextBox1.Text)
'比較秒の取得
sSTime = Format(Now, "SS")
'初期化
lSCount1 = 0: lSCount2 = 0
lECount1 = 0: lECount2 = 37000
Do
'１秒にかかるカウント集計（毎秒数値を確認）
lSCount1 = lSCount1 + 1
If sSTime <> Format(Now, "SS") Then
sSTime = Format(Now, "SS")
lSCount2 = lSCount1
lSCount1 = 0
End If
'ミリ秒
lECount1 = lECount1 + 1
If lECount1 > lECount2 Then
lECount1 = 0
'指定ミリ秒に相当するカウント数を毎回算出
lECount2 = Int(lSCount2 / 1000 * lMiri)
□□イベントの記述□□
TextBox2.Text = lSCount2
TextBox3.Text = lECount2
□□□□□□□□□□□
End If
'ループ脱出処理（無限ループに注意）
DoEvents
If miEnd = True Then Exit Do
Loop
End Sub

処理中の誤差が少しでも少なくなるように
毎秒算出し、ヒットの度に再計算させてあります。
あと無限ループには充分ご注意ください。
長々とすんません…頑張ってください。

通報する

Ｑ、800ミリ秒ごとのイベントを発生させるには？
Ａ、800ミリ秒ごとにイベントをコールする。

処理の実行速度に関わらず、800ミリ秒を足した時刻にイベントをコールすればと思います。

通報する