Option Explicit
Private Const EVENT_SYSTEM_MOVESIZESTART As Long = &HA
Private Const EVENT_SYSTEM_MOVESIZEEND = &HB
Private Const WINEVENT_OUTOFCONTEXT = 0
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As LongLong, ByVal lpfnWinEventProc As LongLong, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
#Else
Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As Long, ByVal lpfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
#End If
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As LongPtr) As Long
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As Long, ByVal lpfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Dim TimerID&
Private pRunningHandles As Collection
Public OldWidth As Double
Public OldHeight As Double
Public Function StartEventHook() As Long
If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
StartEventHook = SetWinEventHook(EVENT_SYSTEM_MOVESIZESTART, EVENT_SYSTEM_MOVESIZEEND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
pRunningHandles.Add StartEventHook
End Function
#If VBA7 Then
Public Sub StopEventHook(lHook As LongPtr)
#Else
Public Sub StopEventHook(lHook As Long)
#End If
Dim LRet As Long
If lHook = 0 Then Exit Sub
LRet = UnhookWinEvent(lHook)
End Sub
Public Sub StartHook()
StartEventHook
OldWidth = Application.Width
OldHeight = Application.Height
End Sub
Public Sub StopAllEventHooks()
Dim vHook As Variant
#If VBA7 Then
Dim lHook As LongPtr
#Else
Dim lHook As Long
#End If
For Each vHook In pRunningHandles
#If VBA7 Then
lHook = CLngPtr(vHook)
#Else
lHook = CLng(vHook)
#End If
StopEventHook lHook
Next vHook
End Sub
#If VBA7 Then
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hwnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
#Else
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hwnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
#End If
'This function is a callback passed to the win32 api
'We CANNOT throw an error or break. Bad things will happen.
On Error Resume Next
Dim thePID As Long
If LEvent = EVENT_SYSTEM_MOVESIZESTART Then
GetWindowThreadProcessId Application.hwnd, thePID
If thePID = GetCurrentProcessId Then
Select Case True
Case Application.Width <> OldWidth
TimerID = SetTimer(0, 0, 2, AddressOf Event_Resize)
Case Else
TimerID = SetTimer(0, 0, 2, AddressOf Event_MoveStart)
End Select
End If
ElseIf LEvent = EVENT_SYSTEM_MOVESIZEEND Then
GetWindowThreadProcessId Application.hwnd, thePID
If thePID = GetCurrentProcessId Then
TimerID = SetTimer(0, 0, 2, AddressOf Event_MoveEnd)
End If
End If
On Error GoTo 0
End Function
Public Sub Event_MoveStart()
If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
[A1] = "Event_MoveStart"
End Sub
Public Sub Event_MoveEnd()
[A1] = "Event_MoveEnd"
If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
End Sub
Public Sub Event_Resize()
[A1] = "Event_Resize"
If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
OldWidth = Application.Width
OldHeight = Application.Height
End Sub