During the course of any VBA developer's life, the desire to want to be able to make a form seem independent of Excel will appear. One nice way to do this is to hide the excel application, so only a userform appears, but it doesnt usually seem the same. One nice thing that can be done to improve the looks (and possible functionality) is to minimize a userform to the system tray. An actual need to do this rarely comes up, but is usually impressive anyways depending on the end user.
I would like to say for the record that I did not create this code. I found some snippets that others had written in the past, and adapted it for my example. As usual, I researched exactly what it is doing so that I can write something similar from scratch as well as help others with any problems they have doing the same. I really don't remember who wrote the initial code that I adapted this from though. If you know, please let me know so I can give them proper credit.
Anyways, this is a pretty simple concept. Create a userform (called UserForm1), and add 2 commandbuttons to it. Keep them at their default name as well. Inside the codepane for the userform, paste the following:
'******************************************************'
'**************** START USERFORM1 CODE ****************'
'******************************************************'
Option Explicit
Private Sub CommandButton1_Click()
Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
Me_hWnd = FindWindowd("ThunderDFrame", UserForm1.Caption)
IconPath = Application.Path & Application.PathSeparator & "excel.exe"
Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
Hook Me_hWnd
AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub UserForm_Activate()
RemoveIconFromTray
Unhook
End Sub
Private Sub UserForm_Initialize()
CommandButton1.Caption = "Minimize to tray"
CommandButton2.Caption = "Close this form"
Application.Visible = False
End Sub
'******************************************************'
'***************** END USERFORM1 CODE *****************'
'******************************************************'
Then insert a new module in the same project, and paste in the following:
'******************************************************'
'***************** START MODULE CODE ******************'
'******************************************************'
Option Explicit
Declare Function SetForegroundWindow Lib "User32" (ByVal hwnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Declare Function CallWindowProc 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
Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _
As String, ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst _
As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)
Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Public nfIconData As NOTIFYICONDATA
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Sub Hook(Lwnd As Long)
If Hooking = False Then
FHandle = Lwnd
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
Hooking = True
End If
End Sub
Public Sub Unhook()
If Hooking = True Then
SetWindowLong FHandle, GWL_WNDPROC, WndProc
Hooking = False
End If
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
If Hooking Then
If lParam = WM_LBUTTONDBL Then
UserForm1.Show 1
WindowProc = True
' Unhook
Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, _
Tip As String)
With nfIconData
.hwnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = Len(nfIconData)
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function
Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal _
nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function
Sub ShowUserForm()
Application.Visible = False
UserForm1.Show 1
End Sub
'******************************************************'
'****************** END MODULE CODE *******************'
'******************************************************'
To try this out, simply run the ShowUserForm subroutine. Pretty cool, huh? Of course this can be quickly ported to run in other office programs as well as vb6, but since I love Excel I see no reason to generalize it for the sake of this post :)
