很多的软件点击最小化按钮后都可以最小化到系统的托盘区域，然后在托盘区域点击图标可以返回程序或者进行更多的操作。但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
"
,
"
"
, 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
本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。
