ディアクテイブでタイマー

README.md

元スレッド EXCEL：他のソフトを使っている間に自動保存する http://okwave.jp/qa/q7600555.html

OKWaveの仕様でインデントが崩れ左寄せになるのを 直すのが面倒なので、必要な判定も削りました。

質問者に分かればいいので。

gistfile1.vb

Option Explicit

Public m_timerid& 'タイマーID
Public m_interval& 'インターバル値
Public m_flg As Boolean 'タイマーが有効/無効のフラグ

Public m_hWnd As Long 'フック対象のウィンドウハンドル
Public pOrgProc As Long '元のウィンドウプロシージャのアドレス

'タイマー開始
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 uIDEvent As Long) As Long


'ウィンドウメッセージ定数
Public Const GWL_WNDPROC = &HFFFC 'ウインドウプロシージャのアドレスを変更する

'指定されたウィンドウの属性を変更する
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'指定されたウィンドウプロシージャにメッセージ情報を渡す
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Public Function DeactiveSaveStart() As Integer
'サブクラス化を開始する

    Dim hWnd As Long
    m_interval = 10000 'インターバル設定(1分)

    'ウィンドウハンドルを取得する
    hWnd = Application.hWnd

    'メッセージフックを開始する
    pOrgProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf DeactiveSaveProc)

End Function

Public Sub DeactiveSaveStop()
'サブクラス化を終了する

    Dim lngRet As Long

    KillTimer 0, m_timerid
    lngRet = SetWindowLong(Application.hWnd, GWL_WNDPROC, pOrgProc)
    pOrgProc = 0
    m_flg = False

End Sub

Public Function DeactiveSaveProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'ウインドウプロシージャにメッセージを渡す前にそれを横取りして必要な処理を実行する

    Dim intFlagActive As Integer

    Const WM_ACTIVATE = &H6
    Const WA_INACTIVE = 0

    If Msg = WM_ACTIVATE Then
        intFlagActive = wParam And &HFFFF&
        If intFlagActive = WA_INACTIVE Then
            Debug.Print "a"

            If Not m_flg Then
                Debug.Print "b"
                m_flg = True
                m_timerid = SetTimer(0, 0, m_interval, AddressOf TimerProc)
            End If
        End If
    End If

    'デフォルトウィンドウプロシージャを呼び出す
    DeactiveSaveProc = CallWindowProc(pOrgProc, hWnd, Msg, wParam, lParam)

End Function

Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)

    KillTimer 0, idEvent
    Debug.Print "test1"
    m_flg = False

End Sub