API関連(APIの利用の例)

サンプルは1秒ごとにウェイトする単純なものですが、なぜウェイトするような処理が必要なのでしょう？

正確に1秒間隔で動作が行なわれるわけではありません．．．ループ処理中のあるところで1秒間処理を停止するというものです。ループの他の処理があればその実行時間が関与するのでループ処理が正確に1秒間隔で動作するのではないということにご注意下さい。

正確な時間間隔で処理を行なうという用途であれば、このページでの方法ではなく、正確な時間間隔でイベントを発生させる「タイマ」が必要です。このような機能はExcelVBAにはなく、VB.NETであれば「タイマコントロール」が標準であるので、この「タイマコントロール」の「Tickイベント」に1回分の記述を行なえば指定の時間間隔でその記述が呼び出されます。

ここでは、繰り返し処理の途中で指定時間動作を停止するということでご覧下さい。

64ビット版Excelの対応を行ないました。このページのサンプルはAPIを使用しております。
Office365やOffice2019では、64ビット版になるという情報があったため、当サイトでも順次この対応を行ない、動作確認ができたものからページを更新しています。

サンプルを起動させ、上の「Sleepのサンプル」ボタンをクリックすると起動します。

(この画像をクリックすると、このページのサンプルがダウンロードができます。)
すると、1秒ずつステータスバーに表示されるようになります。この1秒のインターバルをAPIで処理していますが、インターバルを「ミリ秒」で指定するだけの一番簡単なAPIです。
止める時は、Escキーを押して下さい。

Escキーが押されると、中断確認メッセージが表示されます。
中断キーが押されました。終了しますか？
ここで、「はい」をクリックすれば終了、「いいえ」をクリックすれば、また秒カウントを継続します。

ソースコードです。


'***************************************************************************************************
'   スリープ
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 07/07/15(1.0.0)新規作成
' 17/12/30(1.1.0)再作成
' 19/10/20(2.0.0)64ビットWindows対応、他
'***************************************************************************************************
Option Explicit
'---------------------------------------------------------------------------------------------------
#If VBA7 Then
' ■スリープ(API)
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
#Else
' ■スリープ(API)
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
#End If

'***************************************************************************************************
'* 処理名　：Button1_Click
'* 機能　　：シート上のボタン押下
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2007年07月15日
'* 作成者　：井上　治
'* 更新日　：2019年10月20日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button1_Click()
    '-----------------------------------------------------------------------------------------------
    Dim lngCOUNT As Long
    ' EscｷｰでErrorHandlerへ進ませる
    Application.EnableCancelKey = xlErrorHandler
    On Error GoTo ESC_CHATCH
    '-----------------------------------------------------------------------------------------------
    ' 中断されるまで繰り返す(無限ループ記述)
    Do
        ' カウントをステータスバーに表示
        lngCOUNT = lngCOUNT + 1
        Application.StatusBar = CStr(lngCOUNT)
        ' 1秒WAIT(SleepAPI)
        DoEvents
        Sleep 1000          ' 1000msec
    Loop
    ' 終了
    GoTo LOOP_EXIT

'===================================================================================================
' Escキー押下時の処理
ESC_CHATCH:
    ' Escキー打鍵によるものか
    If Err.Number = 18 Then
        ' 中断キー押下時の確認メッセージ
        If MsgBox("中断キーが押されました。終了しますか？", vbInformation + vbYesNo) <> vbYes Then
            ' 中断箇所に戻る
            Resume
        End If
    Else
        ' その他のエラー
        MsgBox Err.Description, vbCritical
    End If

'===================================================================================================
' 終了処理
LOOP_EXIT:
    ' Escキー処理を戻す
    Application.EnableCancelKey = xlInterrupt
    Application.StatusBar = False
    On Error GoTo 0
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

「Sleep」自体は、赤枠の部分だけです。「Do～Loop」に「Until」や「While」の記述がないので、内部で何かの形で脱出させない限り終了しないような記述です。このため、Esc(Cancel)キーの動作をエラートラップに飛ぶようにし、エラー処理中で「止めるか」を判定させています。

Excelには、「Application.OnTime」で指定時刻に指定プロシージャを起動させる機能があるので、これを使ってある程度代用できますが、プロシージャの処理途中で一定時間停止するような場合はSleepのAPIの方が便利です。

使用例としては、例えば、Accessデータベースの「オートナンバー」のようなことをテキストファイルで行なう場合に、採番管理ファイルを作成して排他でOPENし順に最新番号を取得し書き戻しますが、同時に複数から要求があった場合などは一方はOPENエラーになります。このような時にただエラーを表示するのではなく、数回は数ミリ秒待機してリトライするような方法を採ります。
また、この後のコンポーネントに紹介の中で、メール送受信のコンポーネントの説明がありますが、受信動作を一定時間間隔を空けて繰り返す場合にも有効です。

さて、上記のソースコードはGoToラベルを配置するような方法なので、構造化等の指向からすると良い記述ではないのですが、そうかと言って以下のように記述した場合は、


'***************************************************************************************************
'   スリープ②
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 17/12/30(1.0.0)新規作成(GoTo記述無し)
' 19/10/20(2.0.0)64ビットWindows対応
'***************************************************************************************************
Option Explicit
'---------------------------------------------------------------------------------------------------
#If VBA7 Then
' ■スリープ(API)
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
#Else
' ■スリープ(API)
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
#End If

'***************************************************************************************************
'* 処理名　：Button1_Click
'* 機能　　：シート上のボタン押下
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2017年12月30日
'* 作成者　：井上　治
'* 更新日　：2017年12月30日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button1_Click()
    '-----------------------------------------------------------------------------------------------
    Dim lngCOUNT As Long
    ' EscキーでErrorHandlerへ進ませる
    Application.EnableCancelKey = xlErrorHandler
    On Error Resume Next
    '===============================================================================================
    ' 中断されるまで繰り返す(無限ループ記述)
    Do
        ' カウントをステータスバーに表示
        lngCOUNT = lngCOUNT + 1
        Application.StatusBar = CStr(lngCOUNT)
        'DoEvents
        ' エラー確認
        If Err.Number <> 0 Then
            ' Escキー打鍵によるものか
            If Err.Number = 18 Then
                ' 中断キー押下時の確認メッセージ
                If MsgBox("中断キーが押されました。終了しますか？", vbInformation + vbYesNo) = vbYes Then
                    Exit Do
                End If
            Else
                MsgBox Err.Description, vbCritical
                Exit Do
            End If
        End If
        ' 1秒WAIT(SleepAPI)
        Sleep 1000          ' 1000msec
    Loop
    '===============================================================================================
    ' 終了
    Application.EnableCancelKey = xlInterrupt
    Application.StatusBar = False
    On Error GoTo 0
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

Escキーを押すとループ内の「エラー確認」には進まず、単にループを脱出して終了してしまいます。

VBAの動作を一定時間止める。

サンプルは1秒ごとにウェイトする単純なものですが、なぜウェイトするような処理が必要なのでしょう？