none
EXCEL2019(64bif) call sleep の動作について、 RRS feed

  • 質問

  • 以前2010(32bit)で以下のマクロを実行していました。

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

    Sub 生産()

        Sheets("生産").Select   
        Range("A1").Select
        Call Sleep(10000)
        Sheets("MENU").Select
        Range("A1").Select

    End Sub

    これを、2019(64bit) で動くように

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

    Sub 生産()

        Sheets("生産").Select   
        Range("A1").Select
        Call Sleep(10000)
        Sheets("MENU").Select
        Range("A1").Select

    End Sub

    と修正したところ、コンパイルエラーはなくなったが、「生産」というSheeetに移動せずに

    Sleep時間だけ待て、「MENU」というSheetに移動してしまいます。

    ”Call Sleep以降を削ると、問題なく、「生産」Sheetに移動できます”

    Seelpを読み出す。宣言方法が間違っているのでしょうか?

    2019年6月13日 7:09

すべての返信

  • Excel の処理を待機させることを目的として Sleep API を呼び出してはいけません。

    代わりに MsgWaitForMultipleObjects を使ってみるのはどうでしょうか。

    2019年6月13日 7:42
  • MsgWaitForMultipleObjects のサンプルソースの

    公開場所をご存じないでしょうか?

    VB初心者な為、サンプルコードがあると助かります。

    2019年6月13日 8:02
  • Sleepで固まっているとかですかね。

    Sleep(10000)を下記のように差し換えてはどうでしょうか

    Dim datSleepEnd As Date: datSleepEnd = Now() + TimeSerial(0, 0, 10)

    Do Until Now() >= datSleepEnd
        Call Sleep(1)
        DoEvents
    Loop

    2019年6月13日 8:03
  •     Sheets("生産").Select   

        Range("A1").Select
        Call Sleep(10000)
        Sheets("MENU").Select
        Range("A1").Select

    関係あるかどうかはわかりませんがアクティブなワークシートを切り替えるときは
    Worksheet.Select メソッドではなく、Worksheet.Activate メソッド
    使ってください。

    Worksheet.Select はワークシートを選択するだけです。
    通常は、アクティブなワークシートも設定しますが、機能的には違います。
    例えば同時に複数のワークシートを選択できますがアクティブにできるワークシートは
    常に 1 つだけです。

    2019年6月13日 8:20
  • VB6 のコードであれば、先のリンク先に記載されていたのですけれどね。
    VBA だと、こんな感じでどうでしょう。

    Option Explicit
    #If VBA7 Then
    Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "user32" ( _
        ByVal nCount As Long, _
        ByVal pHandles As LongPtr, _
        ByVal fWaitAll As Long, _
        ByVal dwMilliseconds As Long, _
        ByVal dwWakeMask As Long) As Long
    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
    ' Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    #Else
    Private Declare Function MsgWaitForMultipleObjects Lib "user32" ( _
        ByVal nCount As Long, _
        ByVal pHandles As LongPtr, _
        ByVal fWaitAll As Long, _
        ByVal dwMilliseconds As Long, _
        ByVal dwWakeMask As Long) As Long
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    ' Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    #End If
    
    Public Sub Sleep(ByVal dwMilliseconds As Long)
        Dim bInteractive As Boolean
        bInteractive = Application.Interactive
        Application.Interactive = False
        
        Dim iStart As Long
        iStart = GetTickCount()
        Dim iInterval As Long
        iInterval = dwMilliseconds
        Dim result As Long
        Do
            result = MsgWaitForMultipleObjects(0, 0, 0, iInterval, &HFF&)
            If result = 0 Then
            '   Debug.Print "DoEvents"
                DoEvents
            'Else
            '   Debug.Print "0x" & Hex(result)
            End If
            iInterval = dwMilliseconds - GetTickCount() + iStart
        Loop While iInterval >= 0
        Application.Interactive = bInteractive
    End Sub
    

    MsgWaitForMultipleObjectsの呼び出しは、Sleep と同様に指定時間の待ち合わせを行うために利用できますが、画面描画やマウス操作等などがあると、そこで待機が中断されるようになっています。

    割り込みがあったときにしか DoEvents は呼び出されないため、指定した時間になるまで DoEvents を無限ループで呼び続ける方法よりも CPU 負荷が少なくて済みます。

    2019年6月13日 8:27
  • あと、操作対象のワークブックを明示しないとアクティブなワークブックが
    操作対象になります。
    アクティブなワークブックが常に一定だという保証はありません。
    様々な要因によって意図せずにアクティブなワークブックは変わったりします。

    2019年6月13日 8:32