web-dev-qa-db-ja.com

VBAのタイミング遅延

コードに1秒の遅延が必要です。以下は、この遅延を作成しようとしているコードです。オペレーティングシステムの日付と時刻をポーリングし、時刻が一致するまで待機すると思います。遅延に問題があります。待機時間と一致する時間はポーリングせず、そのまま待機してフリーズするだけだと思います。コードを実行する時間の約5％しかフリーズしません。 Application.Waitと、ポーリング時間が待機時間よりも大きいかどうかを確認する方法があるかどうか疑問に思っていました。

   newHour = Hour(Now())
   newMinute = Minute(Now())
   newSecond = Second(Now()) + 1
   waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime
vbatimerwaitpausetimedelay
16
Lagg Master

この小さな関数をVBAに使用します。

Public Function Pause(NumberOfSeconds As Variant)
    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer = 0 Then
            ' Crossing midnight
            PauseTime = PauseTime - Elapsed
            Start = 0
            Elapsed = 0
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function
23
Steve Mallory

Excel VBAを使用している場合は、次を使用できます。

Application.Wait(Now + TimeValue("0:00:01"))

（時間文字列はH：MM：SSのようになります。）

36
TheFuzzyGiggler

これをモジュールにコピーできます：

Sub WaitFor(NumOfSeconds As Long)
Dim SngSec as Long
SngSec=Timer + NumOfSeconds

Do while timer < sngsec
DoEvents
Loop

End sub

一時停止の書き込みを適用したいときはいつでも：

Call WaitFor(1)

それがお役に立てば幸いです！

12
Financial Economist

スリープを使用しようとしましたか？

例があります [〜＃〜] here [〜＃〜] （以下にコピー）：

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Activate()    

frmSplash.Show
DoEvents
Sleep 1000
Unload Me
frmProfiles.Show

End Sub

選択した期間、アプリケーションがフリーズする可能性があることに注意してください。

6
Tiago Cardoso

タイマー関数は、Access 2007、Access 2010、Access 2013、Access 2016、Access 2007 Developer、Access 2010 Developer、Access 2013 Developerにも適用されます。このコードを挿入して、一定の時間だけ時間を一時停止します

T0 = Timer
Do
    Delay = Timer - T0
Loop Until Delay = 1 'Change this value to pause time in second
2
Anastasiya-Romanova 秀

プロジェクトにMicrosoft Excel XX.Xオブジェクトが含まれている限り、Accessは常にExcelプロシージャを使用できます reference included ：

Call Excel.Application.Wait(DateAdd("s",10,Now()))
2
user3298002

スティーブマロリーズの回答の別のバリエーションとして、待機中にExcelが実行されて処理を実行するのに特に必要でしたが、1秒が長すぎました。

'Wait for the specified number of milliseconds while processing the message pump
'This allows Excel to catch up on background operations
Sub WaitFor(milliseconds As Single)

    Dim finish As Single
    Dim days As Integer

    'Timer is the number of seconds since midnight (as a single)
    finish = Timer + (milliseconds / 1000)
    'If we are near midnight (or specify a very long time!) then finish could be
    'greater than the maximum possible value of timer. Bring it down to sensible
    'levels and count the number of midnights
    While finish >= 86400
        finish = finish - 86400
        days = days + 1
    Wend

    Dim lastTime As Single
    lastTime = Timer

    'When we are on the correct day and the time is after the finish we can leave
    While days >= 0 And Timer < finish
        DoEvents
        'Timer should be always increasing except when it rolls over midnight
        'if it shrunk we've gone back in time or we're on a new day
        If Timer < lastTime Then
            days = days - 1
        End If
        lastTime = Timer
    Wend

End Sub
2
James Barrass

コードは、日付のない時刻のみを作成します。 application.waitを実行すると、実際に既にその時間に達した時間を正確に24時間待つという仮定が正しい場合。また、now（）を複数回呼び出すことについて少し心配します（異なる可能性がありますか？）

 application.wait DateAdd("s", 1, Now)
1
Eddy

スティーブマロリーの答えを使用しましたが、タイマーが86400にも0（ゼロ）シャープにもならない、または少なくとも時々進まない（MS Access 2013）ことを恐れています。そこで、コードを修正しました。真夜中の条件を「If Timer> = 86399 Then」に変更し、次のように「Exit Do」ループのブレークを追加しました。

Public Function Pause(NumberOfSeconds As Variant)
    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer >= 86399
            ' Crossing midnight
            ' PauseTime = PauseTime - Elapsed
            ' Start = 0
            ' Elapsed = 0
            Exit Do
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function
1
Miroslav Kovarik

MS Accessの場合：Me.TimerIntervalが設定された非表示フォームとForm_Timerイベントハンドラーを起動します。遅延させるコードをForm_Timerルーチンに入れます-各実行後にルーチンを終了します。

例えば。：

Private Sub Form_Load()
    Me.TimerInterval = 30000 ' 30 sec
End Sub

Private Sub Form_Timer()

    Dim lngTimerInterval  As Long: lngTimerInterval = Me.TimerInterval

    Me.TimerInterval = 0

    '<Your Code goes here>

    Me.TimerInterval = lngTimerInterval
End Sub

「ここにコードが入ります」は、フォームを開いてから30秒後に実行され、以降の各実行から30秒後に実行されます。

完了したら、非表示のフォームを閉じます。

0
Jim

Windowsでは、タイマーは100分の1秒を返します...ほとんどの人は、Macintoshプラットフォームではタイマーが整数を返すため、秒を使用します。

0
Peter

デュークレジットとSteve Mallroyに感謝します。

Wordに真夜中の問題があり、次のコードが機能しました

Public Function Pause(NumberOfSeconds As Variant)
 '   On Error GoTo Error_GoTo

    Dim PauseTime, Start
    Dim objWord As Word.Document

    'PauseTime = 10 ' Set duration in seconds
    PauseTime = NumberOfSeconds
    Start = Timer ' Set start time.

    If Start + PauseTime > 86399 Then 'playing safe hence 86399

    Start = 0

    Do While Timer > 1
        DoEvents ' Yield to other processes.
    Loop

    End If

    Do While Timer < Start + PauseTime
        DoEvents ' Yield to other processes.
    Loop

End Function
0
Ateeq