很多的软件点击最小化按钮后都可以最小化到系统的托盘区域，然后在托盘区域点击图标可以返回程序或者进行更多的操作。但Excel没有提供这个功能。下面我们就来试一试添加这个功能：
运行效果如下：
代码：
详见附件：
点击下载
运行效果如下：
代码：
'//*******************************************************************************************************************
'//此模块的主要实现点击最小化图标后是EXCEL缩小至系统托盘，然后单击可以还原。//（code by wangminbai）//
'//*******************************************************************************************************************
'//——以下声明API函数——
'//查找指定窗口的子窗口
Private Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As Long
'//取得鼠标状态
Private Declare Function GetCursorPos _
Lib "user32" ( _
lpPoint As POINTAPI) _
As Long
'//设置指定矩形的坐标
Private Declare Function SetRect _
Lib "user32" ( _
lpRect As RECT, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long
'//在lprcFrom和lprcTo之间描绘一系列动态矩形
Private Declare Function DrawAnimatedRects _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal idAni As Long, _
lprcFrom As RECT, _
lprcTo As RECT) _
As Long
'//取得系统环境
Private Declare Function GetSystemMetrics _
Lib "user32" ( _
ByVal nIndex As Long) _
As Long
'//取得窗体坐标区域
Private Declare Function GetWindowRect _
Lib "user32" ( _
ByVal hwnd As Long, _
lpRect As RECT) _
As Long
'//将一个窗口设为前景窗口
Private Declare Function SetForegroundWindow _
Lib "user32" ( _
ByVal hwnd As Long) _
As Long
'//查找指定文件并打开或打印
Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'//提取图标
Private Declare Function ExtractIcon _
Lib "shell32.dll" _
Alias "ExtractIconA" ( _
ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) _
As Long
'//查找窗体
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
'//取得窗体信息
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 Shell_NotifyIcon _
Lib "shell32.dll" _
Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) _
As Long
'-----------------------------------------
'//用来产生TIMER控件的效果。
Private Declare Function SetTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) _
As Long
'//结束Settimer过程
Private Declare Function KillTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) _
As Long
'//设置钩子
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, _
lparam As Any) _
As Long
'//取得当前线程ID
Private Declare Function GetCurrentThreadId _
Lib "kernel32" () _
As Long
'//——以下定义常数及类型——
Private Const NOTIFYICON_VERSION = &H3
'/-------------------------------------------------------------------
Private Const GWL_STYLE = (-16) '窗体样式
Private Const GWL_WNDPROC = (-4)
Private Const WS_MINIMIZEBOX = &H20000 '最小化按钮
Private Const WS_MAXIMIZEBOX = &H10000
'/-------------------------------------------------------------------
Private Const WM_LBUTTONUP = &H202 '鼠标左键
Private Const WM_RBUTTONUP = &H205 '鼠标右键
Private Const WM_NCACTIVATE = &H86 '失去焦点
Private Const WM_USER = &H400
Private Const WM_MYICONHOOK = WM_USER + &H18 '自定义的消息以接受托盘图标发送的信息
Private Const WM_SYSCOMMAND = &H112
'/-------------------------------------------------------------------
Private Const NIM_ADD = &H0 '添加
Private Const NIM_DELETE = &H2 '删除
Private Const NIM_SETVERSION = &H4 '设置版本
Private Const NIM_MODIFY = &H1 '修改
'/-------------------------------------------------------------------
Private Const NIF_MESSAGE = &H1 '消息
Private Const NIF_ICON = &H2 '显示图标
Private Const NIF_TIP = &H4 '提示
Private Const NIF_INFO = &H10 '气球信息
'/气球图标标识-------------------------------------------------------
Private Const NIIF_NONE = &H0 '无图标
Private Const NIIF_INFO = &H1 '信息图标
Private Const NIIF_WARNING = &H2 '警告图标
Private Const NIIF_ERROR = &H3 '错误图标
Private Const NIIF_NOSOUND = &H10 '无声音
'/-------------------------------------------------------------------
Private Const IDANI_OPEN = &H1
Private Const IDANI_CLOSE = &H2
Private Const IDANI_CAPTION = &H3
'/-------------------------------------------------------------------
Private Const HCBT_ACTIVATE = 5
Private Const HCBT_MINMAX = 1
Private Const SW_MINIMIZE = 6
Private Const WH_CBT = 5
'--------------------------------------------------------------------
Private Type NOTIFYICONDATA
cbSize As Long '结构的长度
hwnd As Long '接受消息窗口的句柄
uID As Long '图标ID，可以自定义
uFlags As Long '图标的标识
uCallbackMessage As Long '接受返回信息的类型
hIcon As Long '欲显示的图标
szTip As String * 128 '提示信息
dwState As Long '状态
dwStateMask As Long
szInfo As String * 256 '气球显示信息
uTimeoutAndVersion As Long
szInfoTitle As String * 64 '气球标题
dwInfoFlags As Long '气球显示图标类型
End Type
Type RECT
Left As Long
Bottom As Long
Right As Long
Top As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
'//——以下定义变量——
Private MyData As NOTIFYICONDATA
Private MyBalloonData As NOTIFYICONDATA
Private xlMainHwnd As Long '用于寄存Excel主窗体的句柄
Private OldWindowProc As Long '用于寄存Excel的原窗口过程位址
Private WinRect As RECT, xlMainRect As RECT, NotifyRect As RECT
Private NewBar As CommandBar '用于寄存新建的快捷菜单
'--------------------------------------------------------------------------------------------------------
Private hHook As Long
Private hThreadId As Long
Private Tid As Long
Private WinS As Excel.XlWindowState
'--------------------------------------------------------------------------------------------------------
Private ButtonReturn As CommandBarButton, ButtonQuit As CommandBarButton
Private ButtonAuthor As CommandBarButton, ButtonOffice As CommandBarButton
'//****************************************************************************************************************************************
'//---隐藏主窗体及添加托盘图标---
Private Sub hideHwnd()
Dim ShellTrayHwnd As Long, NotifyHwnd As Long
On Error GoTo handler
'//取得EXCEL的句柄
xlMainHwnd = FindWindow("XLMAIN", Application.Caption)
'//取得任务量栏的句柄
ShellTrayHwnd = FindWindow("Shell_TrayWnd", vbNullString)
'//系统托盘区域句柄
NotifyHwnd = FindWindowEx(ShellTrayHwnd, 0, "TrayNotifyWnd", vbNullString)
NotifyHwnd = FindWindowEx(NotifyHwnd, 0, "SysPager", vbNullString)
'//取得通知区域句柄
NotifyHwnd = FindWindowEx(NotifyHwnd, 0, "ToolbarWindow32", vbNullString)
'//取得通知区域坐标
GetWindowRect NotifyHwnd, NotifyRect
'//设置区域坐标
SetRect WinRect, NotifyRect.Left, NotifyRect.Bottom, NotifyRect.Left + NotifyRect.Top - NotifyRect.Bottom, NotifyRect.Top
'//取得Excel窗体的坐标
GetWindowRect xlMainHwnd, xlMainRect
With MyData
'//结构的长度
.cbSize = Len(MyData)
'//EXCEL的句柄
.hwnd = xlMainHwnd
'//自定义的ID
.uID = 99
'//显示图标，有提示，返回消息
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
'//返回信息来自自定义消息
.uCallbackMessage = WM_MYICONHOOK
'//提取EXCEL的图标为图标
.hIcon = ExtractIcon(0, Application.Path & "\EXCEL.EXE", 0)
'//提示信息
.szTip = "点击恢复Excel 主窗体" & vbNullChar
'//托盘图标的版本
.uTimeoutAndVersion = NOTIFYICON_VERSION
End With
'//改变EXCEL窗口过程，并取得原过程句柄
OldWindowProc = SetWindowLong(xlMainHwnd, GWL_WNDPROC, AddressOf NewWindowProc)
'//添加托盘图标
Shell_NotifyIcon NIM_ADD, MyData
'//通告使用中的NotifyIcon的版本系统
Shell_NotifyIcon NIM_SETVERSION, MyData
'//动画显示窗体可见
DrawAnimatedRects xlMainHwnd, IDANI_CLOSE Or IDANI_CAPTION, xlMainRect, WinRect
'//设置结构
With MyBalloonData
'//结构的长度
.cbSize = Len(MyBalloonData)
'//Excel的句柄
.hwnd = xlMainHwnd
'//自定义的ID
.uID = 99
'//显示气球信息
.uFlags = NIF_INFO
'//信息图标
.dwInfoFlags = NIIF_INFO
'//气球信息标题
.szInfoTitle = "Excel最小化至系统托盘示例" & vbNullChar
'//气球显示的消息
.szInfo = "这是一个Excel最小化至系统托盘示例，你可以左键单击托盘图标还原Excel,或者在图标上单击右键在弹出菜单上进行更多的选择" & vbNullChar
End With
'//更改托盘图标
Shell_NotifyIcon NIM_MODIFY, MyBalloonData
Exit Sub
handler:
MsgBox "添加托盘图标错误:" & vbCrLf & Err.Number & "-" & Err.Description, vbInformation, "错误"
End Sub
'//****************************************************************************************************************************************
'//---SetWindowlong回调函数---
Private Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim AnsBack As Boolean, MyPoint As POINTAPI
On Error GoTo handler
Select Case Msg
'//图标上消息
Case WM_MYICONHOOK
Select Case lparam
'//鼠标左键弹起
Case WM_LBUTTONUP
'//取得当前鼠标位置
GetCursorPos MyPoint
'//设置区域坐标
SetRect WinRect, MyPoint.x, MyPoint.y, MyPoint.x, MyPoint.y
'//假如主窗体不可见
If Application.Visible = False Then
'//动画显示窗体可见
DrawAnimatedRects xlMainHwnd, IDANI_OPEN Or IDANI_CAPTION, WinRect, xlMainRect
'//清除标记
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
'//恢复主窗体消息过程
SetWindowLong xlMainHwnd, GWL_WNDPROC, OldWindowProc
'//恢复Excel主窗体
Application.WindowState = xlMaximized
Application.WindowState = WinS
'//Excel可见
Application.Visible = True
'//恢复主窗体大小
End If
'//鼠标右键弹起
Case WM_RBUTTONUP
'//取得鼠标位置
GetCursorPos MyPoint
'//设置区域坐标
SetRect WinRect, MyPoint.x, MyPoint.y, MyPoint.x, MyPoint.y
'//将Excel窗口设为前景窗口，这里一定要这样做。不然会出现当快捷菜单显示时，不选择菜单项就菜单就不消失的现象。
SetForegroundWindow xlMainHwnd
'//弹出菜单可用
NewBar.Enabled = True
'//显示快捷菜单
NewBar.ShowPopup
Case Else
'//-------------------------------
End Select
'//失去焦点
Case WM_NCACTIVATE
'//快捷菜单不可用
NewBar.Enabled = False
Case Else
'//-------------------------------------
End Select
Exit Function
handler:
Debug.Print "添加托盘图标回调函数错误:" & Err.Number & "-" & Err.Description
End Function
'//---"返回Excel"菜单调用过程---
Sub ReturnExcel()
'//恢复主窗体消息过程
SetWindowLong xlMainHwnd, GWL_WNDPROC, OldWindowProc
If Application.Visible = False Then
'//动画显示窗体可见
DrawAnimatedRects xlMainHwnd, IDANI_OPEN Or IDANI_CAPTION, WinRect, xlMainRect
'//恢复Excel窗体大小
Application.WindowState = xlMaximized
Application.WindowState = WinS
'//使主窗体可见
Application.Visible = True
'//清除标识
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
End If
End Sub
'//---"退出Excel"菜单调用程序---
Sub QuitExcel()
'//恢复主窗体消息过程
SetWindowLong xlMainHwnd, GWL_WNDPROC, OldWindowProc
'//活动窗口最大化
Application.ActiveWindow.WindowState = xlMaximized
'//清除标识
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
'//退出程序
Application.Quit
End Sub
'//---"联系作者"菜单调用过程---
Sub MailAuthor()
ShellExecute 0, "open", "mailto:" & "758237@qq.com" & "?subject=关于添加托盘图标", vbNullString, vbNullString, 0
End Sub
'//---"OFFICEFANS"菜单调用程序---
Sub OpenNet()
ShellExecute 0, "open", "http://www.cnblogs.com/wangminbai", vbNullString, vbNullString, 0
End Sub
'//***********************************************************************************************************
Public Sub EnableHook()
If hHook <> 0 Then
Else
'取得当前线程ID
hThreadId = GetCurrentThreadId
'设置钩子
hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, Application.Hinstance, hThreadId)
End If
End Sub
Public Sub FreeHook()
On Error Resume Next
If hHook <> 0 Then
'取消钩子
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
On Error GoTo 0
End Sub
'---钩子回调---
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
If nCode < 0 Then
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
Exit Function
End If
'窗体最大最小化
If nCode = HCBT_MINMAX Then
'判断是否为Excel主窗口
If wParam = Application.hwnd Then
'判断是否为最小化
If lparam = SW_MINIMIZE Then
WinS = Application.WindowState
Call hideHwnd
If Tid <> 0 Then
Else
'设置SetTimer
Tid = SetTimer(0, 0, 200, AddressOf pMsgOutProc)
End If
End If
End If
End If
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
End Function
'---SetTimer回调---
Private Function pMsgOutProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
'主窗体不可见
Application.Visible = False
'结束SetTimer
KillTimer 0, Tid
Tid = 0
End Function
'*************************************************************************************************************
'---初始化添加菜单---
Sub Init()
On Error Resume Next
' //去除主窗体最小化按钮
Application.CommandBars("NewBar").Delete
'//建立新的快捷菜单，此菜单将用于托盘图标
Set NewBar = Application.CommandBars.Add("NewBar", msoBarPopup, , True)
'//给菜单添加新的菜单项（4个）
With NewBar
Set ButtonAuthor = .Controls.Add
Set ButtonOffice = .Controls.Add
Set ButtonReturn = .Controls.Add
Set ButtonQuit = .Controls.Add
'//给新建的的菜单项设置属性
With ButtonAuthor
.Caption = "联系作者"
.FaceId = 3708
.OnAction = "MailAuthor"
End With
With ButtonOffice
.Caption = "我的博客"
.FaceId = 3903
.OnAction = "OpenNet"
End With
With ButtonReturn
.Caption = "返回Excel"
.FaceId = 125
.OnAction = "ReturnExcel"
.BeginGroup = True
End With
With ButtonQuit
.Caption = "退出Excel"
.FaceId = 103
.OnAction = "QuitExcel"
End With
End With
On Error GoTo 0
Call EnableHook
End Sub
'//此模块的主要实现点击最小化图标后是EXCEL缩小至系统托盘，然后单击可以还原。//（code by wangminbai）//
'//*******************************************************************************************************************
'//——以下声明API函数——
'//查找指定窗口的子窗口
Private Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As Long
'//取得鼠标状态
Private Declare Function GetCursorPos _
Lib "user32" ( _
lpPoint As POINTAPI) _
As Long
'//设置指定矩形的坐标
Private Declare Function SetRect _
Lib "user32" ( _
lpRect As RECT, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long
'//在lprcFrom和lprcTo之间描绘一系列动态矩形
Private Declare Function DrawAnimatedRects _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal idAni As Long, _
lprcFrom As RECT, _
lprcTo As RECT) _
As Long
'//取得系统环境
Private Declare Function GetSystemMetrics _
Lib "user32" ( _
ByVal nIndex As Long) _
As Long
'//取得窗体坐标区域
Private Declare Function GetWindowRect _
Lib "user32" ( _
ByVal hwnd As Long, _
lpRect As RECT) _
As Long
'//将一个窗口设为前景窗口
Private Declare Function SetForegroundWindow _
Lib "user32" ( _
ByVal hwnd As Long) _
As Long
'//查找指定文件并打开或打印
Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'//提取图标
Private Declare Function ExtractIcon _
Lib "shell32.dll" _
Alias "ExtractIconA" ( _
ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) _
As Long
'//查找窗体
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
'//取得窗体信息
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 Shell_NotifyIcon _
Lib "shell32.dll" _
Alias "Shell_NotifyIconA" ( _
ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) _
As Long
'-----------------------------------------
'//用来产生TIMER控件的效果。
Private Declare Function SetTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) _
As Long
'//结束Settimer过程
Private Declare Function KillTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) _
As Long
'//设置钩子
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, _
lparam As Any) _
As Long
'//取得当前线程ID
Private Declare Function GetCurrentThreadId _
Lib "kernel32" () _
As Long
'//——以下定义常数及类型——
Private Const NOTIFYICON_VERSION = &H3
'/-------------------------------------------------------------------
Private Const GWL_STYLE = (-16) '窗体样式
Private Const GWL_WNDPROC = (-4)
Private Const WS_MINIMIZEBOX = &H20000 '最小化按钮
Private Const WS_MAXIMIZEBOX = &H10000
'/-------------------------------------------------------------------
Private Const WM_LBUTTONUP = &H202 '鼠标左键
Private Const WM_RBUTTONUP = &H205 '鼠标右键
Private Const WM_NCACTIVATE = &H86 '失去焦点
Private Const WM_USER = &H400
Private Const WM_MYICONHOOK = WM_USER + &H18 '自定义的消息以接受托盘图标发送的信息
Private Const WM_SYSCOMMAND = &H112
'/-------------------------------------------------------------------
Private Const NIM_ADD = &H0 '添加
Private Const NIM_DELETE = &H2 '删除
Private Const NIM_SETVERSION = &H4 '设置版本
Private Const NIM_MODIFY = &H1 '修改
'/-------------------------------------------------------------------
Private Const NIF_MESSAGE = &H1 '消息
Private Const NIF_ICON = &H2 '显示图标
Private Const NIF_TIP = &H4 '提示
Private Const NIF_INFO = &H10 '气球信息
'/气球图标标识-------------------------------------------------------
Private Const NIIF_NONE = &H0 '无图标
Private Const NIIF_INFO = &H1 '信息图标
Private Const NIIF_WARNING = &H2 '警告图标
Private Const NIIF_ERROR = &H3 '错误图标
Private Const NIIF_NOSOUND = &H10 '无声音
'/-------------------------------------------------------------------
Private Const IDANI_OPEN = &H1
Private Const IDANI_CLOSE = &H2
Private Const IDANI_CAPTION = &H3
'/-------------------------------------------------------------------
Private Const HCBT_ACTIVATE = 5
Private Const HCBT_MINMAX = 1
Private Const SW_MINIMIZE = 6
Private Const WH_CBT = 5
'--------------------------------------------------------------------
Private Type NOTIFYICONDATA
cbSize As Long '结构的长度
hwnd As Long '接受消息窗口的句柄
uID As Long '图标ID，可以自定义
uFlags As Long '图标的标识
uCallbackMessage As Long '接受返回信息的类型
hIcon As Long '欲显示的图标
szTip As String * 128 '提示信息
dwState As Long '状态
dwStateMask As Long
szInfo As String * 256 '气球显示信息
uTimeoutAndVersion As Long
szInfoTitle As String * 64 '气球标题
dwInfoFlags As Long '气球显示图标类型
End Type
Type RECT
Left As Long
Bottom As Long
Right As Long
Top As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
'//——以下定义变量——
Private MyData As NOTIFYICONDATA
Private MyBalloonData As NOTIFYICONDATA
Private xlMainHwnd As Long '用于寄存Excel主窗体的句柄
Private OldWindowProc As Long '用于寄存Excel的原窗口过程位址
Private WinRect As RECT, xlMainRect As RECT, NotifyRect As RECT
Private NewBar As CommandBar '用于寄存新建的快捷菜单
'--------------------------------------------------------------------------------------------------------
Private hHook As Long
Private hThreadId As Long
Private Tid As Long
Private WinS As Excel.XlWindowState
'--------------------------------------------------------------------------------------------------------
Private ButtonReturn As CommandBarButton, ButtonQuit As CommandBarButton
Private ButtonAuthor As CommandBarButton, ButtonOffice As CommandBarButton
'//****************************************************************************************************************************************
'//---隐藏主窗体及添加托盘图标---
Private Sub hideHwnd()
Dim ShellTrayHwnd As Long, NotifyHwnd As Long
On Error GoTo handler
'//取得EXCEL的句柄
xlMainHwnd = FindWindow("XLMAIN", Application.Caption)
'//取得任务量栏的句柄
ShellTrayHwnd = FindWindow("Shell_TrayWnd", vbNullString)
'//系统托盘区域句柄
NotifyHwnd = FindWindowEx(ShellTrayHwnd, 0, "TrayNotifyWnd", vbNullString)
NotifyHwnd = FindWindowEx(NotifyHwnd, 0, "SysPager", vbNullString)
'//取得通知区域句柄
NotifyHwnd = FindWindowEx(NotifyHwnd, 0, "ToolbarWindow32", vbNullString)
'//取得通知区域坐标
GetWindowRect NotifyHwnd, NotifyRect
'//设置区域坐标
SetRect WinRect, NotifyRect.Left, NotifyRect.Bottom, NotifyRect.Left + NotifyRect.Top - NotifyRect.Bottom, NotifyRect.Top
'//取得Excel窗体的坐标
GetWindowRect xlMainHwnd, xlMainRect
With MyData
'//结构的长度
.cbSize = Len(MyData)
'//EXCEL的句柄
.hwnd = xlMainHwnd
'//自定义的ID
.uID = 99
'//显示图标，有提示，返回消息
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
'//返回信息来自自定义消息
.uCallbackMessage = WM_MYICONHOOK
'//提取EXCEL的图标为图标
.hIcon = ExtractIcon(0, Application.Path & "\EXCEL.EXE", 0)
'//提示信息
.szTip = "点击恢复Excel 主窗体" & vbNullChar
'//托盘图标的版本
.uTimeoutAndVersion = NOTIFYICON_VERSION
End With
'//改变EXCEL窗口过程，并取得原过程句柄
OldWindowProc = SetWindowLong(xlMainHwnd, GWL_WNDPROC, AddressOf NewWindowProc)
'//添加托盘图标
Shell_NotifyIcon NIM_ADD, MyData
'//通告使用中的NotifyIcon的版本系统
Shell_NotifyIcon NIM_SETVERSION, MyData
'//动画显示窗体可见
DrawAnimatedRects xlMainHwnd, IDANI_CLOSE Or IDANI_CAPTION, xlMainRect, WinRect
'//设置结构
With MyBalloonData
'//结构的长度
.cbSize = Len(MyBalloonData)
'//Excel的句柄
.hwnd = xlMainHwnd
'//自定义的ID
.uID = 99
'//显示气球信息
.uFlags = NIF_INFO
'//信息图标
.dwInfoFlags = NIIF_INFO
'//气球信息标题
.szInfoTitle = "Excel最小化至系统托盘示例" & vbNullChar
'//气球显示的消息
.szInfo = "这是一个Excel最小化至系统托盘示例，你可以左键单击托盘图标还原Excel,或者在图标上单击右键在弹出菜单上进行更多的选择" & vbNullChar
End With
'//更改托盘图标
Shell_NotifyIcon NIM_MODIFY, MyBalloonData
Exit Sub
handler:
MsgBox "添加托盘图标错误:" & vbCrLf & Err.Number & "-" & Err.Description, vbInformation, "错误"
End Sub
'//****************************************************************************************************************************************
'//---SetWindowlong回调函数---
Private Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim AnsBack As Boolean, MyPoint As POINTAPI
On Error GoTo handler
Select Case Msg
'//图标上消息
Case WM_MYICONHOOK
Select Case lparam
'//鼠标左键弹起
Case WM_LBUTTONUP
'//取得当前鼠标位置
GetCursorPos MyPoint
'//设置区域坐标
SetRect WinRect, MyPoint.x, MyPoint.y, MyPoint.x, MyPoint.y
'//假如主窗体不可见
If Application.Visible = False Then
'//动画显示窗体可见
DrawAnimatedRects xlMainHwnd, IDANI_OPEN Or IDANI_CAPTION, WinRect, xlMainRect
'//清除标记
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
'//恢复主窗体消息过程
SetWindowLong xlMainHwnd, GWL_WNDPROC, OldWindowProc
'//恢复Excel主窗体
Application.WindowState = xlMaximized
Application.WindowState = WinS
'//Excel可见
Application.Visible = True
'//恢复主窗体大小
End If
'//鼠标右键弹起
Case WM_RBUTTONUP
'//取得鼠标位置
GetCursorPos MyPoint
'//设置区域坐标
SetRect WinRect, MyPoint.x, MyPoint.y, MyPoint.x, MyPoint.y
'//将Excel窗口设为前景窗口，这里一定要这样做。不然会出现当快捷菜单显示时，不选择菜单项就菜单就不消失的现象。
SetForegroundWindow xlMainHwnd
'//弹出菜单可用
NewBar.Enabled = True
'//显示快捷菜单
NewBar.ShowPopup
Case Else
'//-------------------------------
End Select
'//失去焦点
Case WM_NCACTIVATE
'//快捷菜单不可用
NewBar.Enabled = False
Case Else
'//-------------------------------------
End Select
Exit Function
handler:
Debug.Print "添加托盘图标回调函数错误:" & Err.Number & "-" & Err.Description
End Function
'//---"返回Excel"菜单调用过程---
Sub ReturnExcel()
'//恢复主窗体消息过程
SetWindowLong xlMainHwnd, GWL_WNDPROC, OldWindowProc
If Application.Visible = False Then
'//动画显示窗体可见
DrawAnimatedRects xlMainHwnd, IDANI_OPEN Or IDANI_CAPTION, WinRect, xlMainRect
'//恢复Excel窗体大小
Application.WindowState = xlMaximized
Application.WindowState = WinS
'//使主窗体可见
Application.Visible = True
'//清除标识
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
End If
End Sub
'//---"退出Excel"菜单调用程序---
Sub QuitExcel()
'//恢复主窗体消息过程
SetWindowLong xlMainHwnd, GWL_WNDPROC, OldWindowProc
'//活动窗口最大化
Application.ActiveWindow.WindowState = xlMaximized
'//清除标识
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
'//退出程序
Application.Quit
End Sub
'//---"联系作者"菜单调用过程---
Sub MailAuthor()
ShellExecute 0, "open", "mailto:" & "758237@qq.com" & "?subject=关于添加托盘图标", vbNullString, vbNullString, 0
End Sub
'//---"OFFICEFANS"菜单调用程序---
Sub OpenNet()
ShellExecute 0, "open", "http://www.cnblogs.com/wangminbai", vbNullString, vbNullString, 0
End Sub
'//***********************************************************************************************************
Public Sub EnableHook()
If hHook <> 0 Then
Else
'取得当前线程ID
hThreadId = GetCurrentThreadId
'设置钩子
hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, Application.Hinstance, hThreadId)
End If
End Sub
Public Sub FreeHook()
On Error Resume Next
If hHook <> 0 Then
'取消钩子
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
On Error GoTo 0
End Sub
'---钩子回调---
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
If nCode < 0 Then
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
Exit Function
End If
'窗体最大最小化
If nCode = HCBT_MINMAX Then
'判断是否为Excel主窗口
If wParam = Application.hwnd Then
'判断是否为最小化
If lparam = SW_MINIMIZE Then
WinS = Application.WindowState
Call hideHwnd
If Tid <> 0 Then
Else
'设置SetTimer
Tid = SetTimer(0, 0, 200, AddressOf pMsgOutProc)
End If
End If
End If
End If
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
End Function
'---SetTimer回调---
Private Function pMsgOutProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
'主窗体不可见
Application.Visible = False
'结束SetTimer
KillTimer 0, Tid
Tid = 0
End Function
'*************************************************************************************************************
'---初始化添加菜单---
Sub Init()
On Error Resume Next
' //去除主窗体最小化按钮
Application.CommandBars("NewBar").Delete
'//建立新的快捷菜单，此菜单将用于托盘图标
Set NewBar = Application.CommandBars.Add("NewBar", msoBarPopup, , True)
'//给菜单添加新的菜单项（4个）
With NewBar
Set ButtonAuthor = .Controls.Add
Set ButtonOffice = .Controls.Add
Set ButtonReturn = .Controls.Add
Set ButtonQuit = .Controls.Add
'//给新建的的菜单项设置属性
With ButtonAuthor
.Caption = "联系作者"
.FaceId = 3708
.OnAction = "MailAuthor"
End With
With ButtonOffice
.Caption = "我的博客"
.FaceId = 3903
.OnAction = "OpenNet"
End With
With ButtonReturn
.Caption = "返回Excel"
.FaceId = 125
.OnAction = "ReturnExcel"
.BeginGroup = True
End With
With ButtonQuit
.Caption = "退出Excel"
.FaceId = 103
.OnAction = "QuitExcel"
End With
End With
On Error GoTo 0
Call EnableHook
End Sub
详见附件：
点击下载
