XL 2016 VBA - Comment détecter la changement de position d'une fenêtre ?

'patricktoulon
#If VBA7 Then
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
                              ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr

    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                              ByVal hHook As LongPtr) As Long

    Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                              ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
                                                ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

#Else
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
                              ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

    Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
                              ByVal hHook As Long) As Long

    Private Declare Function CallNextHookEx Lib "user32" ( _
                              ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
                                        ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#End If

' Constantes pour les événements souris
Const WM_MOUSEMOVE As Long = &H200
Const WM_LBUTTONDOWN As Long = &H201
Const WM_LBUTTONUP As Long = &H202

Dim MouseIsDown As Boolean ' Variable pour suivre l'état du bouton de la souris

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As LongPtr
End Type

Dim hHook As LongPtr
Dim oldleft As Long
' Fonction Hook pour la souris
Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    'patricktoulon
    Dim mouseInfo As MSLLHOOKSTRUCT

    If nCode = 0 Then
        ' Copie des données de la souris
        CopyMemory mouseInfo, ByVal lParam, LenB(mouseInfo)

        ' Gestion des événements
        Select Case wParam
            Case WM_LBUTTONDOWN
                MouseIsDown = True
                  
            Case WM_MOUSEMOVE
                If MouseIsDown Then
                    On Error Resume Next
 If oldleft = 0 Then oldleft = Application.Left
            

                    If Application.Left <> oldleft Then oldleft = Application.Left: DragingWindow
                    On Error GoTo 0
                End If
                
            Case WM_LBUTTONUP
                If MouseIsDown Then
                    MouseIsDown = False
                    oldleft = 0
                    If Application.Left <> oldleft Then StopDragingWindow
                End If
        End Select
    End If

    ' Passer au prochain Hook
    MouseProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

' Démarre le Hook
Sub StartMouseHook()
    Const WH_MOUSE_LL As Long = 14
    hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, 0, 0)
    If hHook = 0 Then MsgBox "Impossible d'installer le Hook", vbCritical
End Sub

' Arrête le Hook
Sub StopMouseHook()
    On Error Resume Next
    If hHook <> 0 Then
        UnhookWindowsHookEx hHook
        hHook = 0
        MsgBox "Hook souris arrêté", vbInformation
    End If
End Sub

'les faux events
Public Sub DragingWindow()
    On Error Resume Next
    [a1] = "déplacement"
End Sub

Public Sub StopDragingWindow()
    On Error Resume Next
    [a1] = "arrêt du déplacement"
End Sub

Private Sub Event_MoveStart()
    'Debug.Print "Event_MoveStart"
    If Not ClassGeneralEvent Is Nothing Then
        Call ClassGeneralEvent.App_WindowMoveStart
    End If
End Sub

Private Sub Event_MoveEnd()
    'Debug.Print "Event_MoveEnd"
    If Not ClassGeneralEvent Is Nothing Then
        Call ClassGeneralEvent.App_WindowMoveEnd
    End If
End Sub

Dim LastTop As Long
Dim LastLeft As Long

Sub SurveillePositionFenetre()
    Dim CurrentTop As Long
    Dim CurrentLeft As Long
    
    CurrentTop = Application.top
    CurrentLeft = Application.left

    If CurrentTop <> LastTop Or CurrentLeft <> LastLeft Then
        MsgBox "La position de la fenêtre Excel a changé !" & vbCrLf & _
               "Nouvelle position : " & vbCrLf & _
               "Top : " & CurrentTop & vbCrLf & _
               "Left : " & CurrentLeft, vbExclamation, "Alerte Position Fenêtre"

        LastTop = CurrentTop
        LastLeft = CurrentLeft
    End If
    
    Application.OnTime Now + TimeValue("00:00:01"), "SurveillePositionFenetre"
End Sub

Sub InitialiserSurveillance()
    LastTop = Application.top
    LastLeft = Application.left
    
    SurveillePositionFenetre
End Sub

Sub StopSurveillance()
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "SurveillePositionFenetre", Schedule:=False
End Sub

Set UserForm = CallByName(UserForms, "Add", VbMethod, UserFormName)

For Each w In Windows
    If w.Hwnd = h Then MsgBox w.Caption
Next w

 UserFormName = "UserForm3"
    Set uf = VBA.UserForms.Add(UserFormName)
    uf.Show

Sub testd()
    UserFormName = "UserForm3"
    Set uf = VBA.UserForms.Add(UserFormName)
    Set uf2 = VBA.UserForms.Add(UserFormName)
    uf.Show 0
    uf2.Show 0
End Sub