Option Explicit
[COLOR=#008000]'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Error-Safe version.
'Code to minimize an excel modal userform to the taskbar.
'Once the userform is minimized, the user can interact with excel.
'Written by Jaafar Tribak @ MrExcel.com on 22/10/2018.
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\[/COLOR]
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "Oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPtr
Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function EnableWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal fEnable As Long) As Long
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
Private FrmHwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function EnableWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private FrmHwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)
Private Const WS_EX_APPWINDOW = &H40000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MINIMIZE = &HF020&
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOP = 0
Private Const KEYEVENTF_KEYUP = &H2
Private bClosing As Boolean
Public Sub MakeFormModeless(ByVal Form As Object)
Form.Show vbModeless
bClosing = False
Set Form = Nothing
'Run a loop to fake Modal UserForm.
Do
DoEvents
Loop Until bClosing
bClosing = False
End Sub
Public Property Let EnabelExcel(ByVal Enable As Boolean)
EnableWindow Application.hwnd, CLng(Enable)
End Property
Public Function GetFormHwnd(ByVal Frm As Object)
WindowFromAccessibleObject Frm, FrmHwnd
SetProp Application.hwnd, "HWND", FrmHwnd
Set Frm = Nothing
End Function
Public Sub AddMinimizeButton(Optional ByVal Dummy As Boolean)
SetWindowLong FrmHwnd, GWL_STYLE, GetWindowLong(FrmHwnd, GWL_STYLE) Or WS_MINIMIZEBOX
End Sub
Public Sub AddToTaskBar(Optional ByVal Dummy As Boolean)
SetWindowPos FrmHwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_HIDEWINDOW Or SWP_NOACTIVATE
SetWindowLong FrmHwnd, GWL_EXSTYLE, GetWindowLong(FrmHwnd, GWL_EXSTYLE) Or WS_EX_APPWINDOW
SetWindowPos FrmHwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE
End Sub
[COLOR=#008000]'Routine to prevent excel from freezing should an unhandled error occur.[/COLOR]
Public Sub RunSafetyRoutine(Optional ByVal Dummy As Boolean)
SetTimer Application.hwnd, 0, 2000, AddressOf SafetyRoutine
End Sub
Public Property Get FormIsMinimized(Optional ByVal Dummy As Boolean) As Boolean
FormIsMinimized = CBool(IsIconic(FrmHwnd))
End Property
Public Sub BringExcelToFront(Optional ByVal Dummy As Boolean)
SetForegroundWindow Application.hwnd
SetWindowPos Application.hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
End Sub
Public Sub PressESCKey(Optional ByVal Dummy As Boolean)
If CBool(IsIconic(FrmHwnd)) Then
keybd_event vbKeyEscape, 0, 0, 0
keybd_event vbKeyEscape, 0, KEYEVENTF_KEYUP, 0
End If
End Sub
Public Sub MiniMizeForm(Optional ByVal Dummy As Boolean)
SendMessage FrmHwnd, WM_SYSCOMMAND, SC_MINIMIZE, 0
End Sub
Public Property Let FormClosing(ByVal Closing As Boolean)
bClosing = Closing
End Property
Public Sub CleanUp(Optional ByVal Dummy As Boolean)
KillTimer Application.hwnd, 0
bClosing = True
EnabelExcel = True
Application.CellDragAndDrop = CBool(GetProp(Application.hwnd, "CellDragAndDrop"))
RemoveProp Application.hwnd, "CellDragAndDrop"
RemoveProp Application.hwnd, "HWND"
End Sub
Private Sub SafetyRoutine()
If IsWindow(GetProp(Application.hwnd, "HWND")) = 0 Then
Call CleanUp
Else
SetProp Application.hwnd, "CellDragAndDrop", 1
End If
End Sub