--- Soumis par Dev Ashish---

Détecter l'activation d'Access.

Note: Pour tester le code de cet article, vous devez avoir également le code pour AddressOf.

    En sous-classant le formulaire, vous pouvez déterminer le moment où Access gagne ou perd le statut de fenêtre active.

   Créer un formulaire PopUp  frmAppStatus, y placer l'étiquette lblStatus. Depuis sa procédure événementielle OnOpen et OnUnload, appeler les sous-routines Hook et UnHook comme suit:

'********** Code Start **********
Private Sub Form_Open(Cancel as Integer)
	Call sHook(Me.hWnd, "fWatchActiveStatus")
End Sub

Private Sub Form_Unload(Cancel as Integer)
	Call sUnHook(Me.hWnd)
End Sub
'********** Code End **********

Place this code in a new module and compile and Save all Modules.

'*********** Code Start ************
Private Declare Function apiCallWindowProc Lib "user32" _
    Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, _
    ByVal Hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) _
    As Long
   
Private Declare Function apiSetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
    (ByVal Hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal wNewWord As Long) _
    As Long

Private Declare Function apiGetWindowLong Lib "user32" _
    Alias "GetWindowLongA" _
   (ByVal Hwnd As Long, _
   ByVal nIndex As Long) _
   As Long


Private lpPrevWndProc  As Long
Private Const GWL_WNDPROC  As Long = (-4)
Private Const WM_ACTIVATEAPP = &H1C

Function fWatchActiveStatus( _
                ByVal hw As Long, _
                ByVal uMsg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long) _
                As Long
                
    On Error Resume Next
    If uMsg = WM_ACTIVATEAPP Then
        If wParam <> 0 Then
            Forms!frmAppStatus!lblStatus.Caption = _
                    "Woohoo!  J'ai le focus à nouveau!  Merci!!"
        Else
            Forms!frmAppStatus!lblStatus.Caption = _
                    "Whaasamatta???  Je ne fais plus l'affaire, maintenant??"
        End If
    End If
    fWatchActiveStatus = apiCallWindowProc( _
                            ByVal lpPrevWndProc, _
                            ByVal hw, _
                            ByVal uMsg, _
                            ByVal wParam, _
                            ByVal lParam)
End Function
'***************** Code End ***************