洛克王国推荐配置:最小化Excel 至系统托盘

最小化Excel 至系统托盘（1）
2007-12-12 15:02
主     题
最小化Excel 至系统托盘
版     本
Excel2000及其以后版本
说     明
本示例主要运用API函数来最小化Excel 至系统托盘，并可以单击或右击托盘图标还原Excel。（Code By 王明柏）
在很多的程序中当我们点击程序的最小化按钮时程序就会最小化至系统的托盘中，而且在最小化至系统托盘时会显示一个气球信息。当我们点击托盘中的图标或点击鼠标右键菜单时程序就会还原。比如 金山词霸 等软件，那我们在Excel 中能实现这种功能吗？可以的，现在就试一试：
l         在Excel 的VBE窗口中添加一个模块，在此模块和ThisWorkbook中添加后面所列代码
l         在表格中添加一窗体按钮，并将其宏设置为 Example。此供示范之用。具体见附件。
l         显示效果
托盘图标右键菜单：
最小化到托盘时的气球信息
鼠标停留在托盘图标的提示信息：



最小化Excel 至系统托盘（2）
2007-12-12 15:08
模块中代码：
'//*******************************************************************************************************************
'//此模块的主要实现点击最小化图标后是EXCEL缩小至系统托盘，然后单击可以还原.//
'//*******************************************************************************************************************
'//——以下声明API函数——
'//播放音频文件
Private Declare Function PlaySound _
Lib "winmm.dll" _
Alias "PlaySoundA" ( _
ByVal lpszName As String, _
ByVal hModule As Long, _
ByVal dwFlags As Long) _
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
'//重绘窗体菜单
Private Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal Hwnd As Long) _
As Long
最小化Excel 至系统托盘（3）
2007-12-12 15:09
'//——以下定义常数及类型——
Private Const NOTIFYICON_VERSION = &H3
'/-------------------------------------------------------------------
Private Const GWL_STYLE = (-16)           '窗体样式
Private Const GWL_WNDPROC = (-4)
Private Const WS_MINIMIZEBOX = &H20000    '最小化按钮
'/-------------------------------------------------------------------
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 SND_ASYNC = &H1            '异步播放
Private Const SND_FILENAME = &H20000      '名称是一文件名
'/-------------------------------------------------------------------
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
'//——以下定义变量——
Private MyData As NOTIFYICONDATA
Private MyBalloonData As NOTIFYICONDATA
Private xlHwnd As Long                   '用于寄存Excel主窗体的句柄
Private OldWindowProc As Long             '用于寄存Excel的原窗口过程位址
Public NewBar As CommandBar               '用于寄存新建的快捷菜单
最小化Excel 至系统托盘（4）
2007-12-12 15:10
'//****************************************************************************************************************************************
'//隐藏主窗体及添加托盘图标
'//****************************************************************************************************************************************
Public Sub hideHwnd()
On Error GoTo handler
'//取得EXCEL的句柄
xlHwnd = FindWindow(vbNullString, Application.Caption)
With MyData
'//结构的长度
.cbSize = Len(MyData)
'//EXCEL的句柄
.Hwnd = xlHwnd
'//自定义的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(xlHwnd, GWL_WNDPROC, AddressOf NewWindowProc)
'//添加托盘图标
Shell_NotifyIcon NIM_ADD, MyData
'//通告使用中的NotifyIcon的版本系统
Shell_NotifyIcon NIM_SETVERSION, MyData
'//主窗体不可见
Application.Visible = False
With MyBalloonData
'//结构的长度
.cbSize = Len(MyBalloonData)
'//Excel的句柄
.Hwnd = xlHwnd
'//自定义的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
最小化Excel 至系统托盘（5）
2007-12-12 15:11
'//****************************************************************************************************************************************
'//回调函数
Public Function NewWindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim AnsBack As Boolean
On Error GoTo handler
Select Case Msg
'//图标上消息
Case WM_MYICONHOOK
Select Case lParam
'//鼠标左键弹起
Case WM_LBUTTONUP
'//假如主窗体不可见
If Application.Visible = False Then
'//使主窗体可见
Application.Visible = True
'//清除标记
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
'//恢复主窗体消息过程
SetWindowLong xlHwnd, GWL_WNDPROC, OldWindowProc
'//重绘主窗体菜单
DrawMenuBar xlHwnd
'//活动窗口最大化，如在重绘窗体前最大化则会使主窗体的标题栏无法显示活动窗口的标题
ActiveWindow.WindowState = xlMaximized
End If
'//鼠标右键弹起
Case WM_RBUTTONUP
'//播放音频
PlaySound "C:\WINDOWS\MEDIA\ir_end.wav", ByVal 0&, SND_FILENAME Or SND_ASYNC
'//将Excel窗口设为前景窗口，这里一定要这样做。不然会出现当快捷菜单显示时，不选择菜单项就菜单就不消失的现象。
SetForegroundWindow xlHwnd
'//弹出菜单可用
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 至系统托盘（6）
2007-12-12 15:11
'//****************************************************************************************************************************************
'//以下过程为工作表中按钮调用
Sub Example()
'//活动窗口最小化
Application.ActiveWindow.WindowState = xlMinimized
End Sub
'//****************************************************************************************************************************************
'//代码去除Excel 主窗体最小化按钮，此过程在打开文档时调用
Sub DelMinimizeBox()
Dim xLType As Long, Hwnd As Long
'//EXCEL2002以上可以直接使用Application.Hwnd取得句柄,其他的版本要用到Findwindow函数
Hwnd = FindWindow(vbNullString, Application.Caption)
xLType = GetWindowLong(Hwnd, GWL_STYLE)
'//如果去除最大化按钮，程序在从托盘还原时有问题。注意！！！！
xLType = xLType And Not WS_MINIMIZEBOX
'//设置窗体的新信息
SetWindowLong Application.Hwnd, GWL_STYLE, xLType
'//重绘主窗体菜单
DrawMenuBar Hwnd
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------
'//"返回Excel"菜单调用过程
Sub ReturnExcel()
'//恢复主窗体消息过程
SetWindowLong xlHwnd, GWL_WNDPROC, OldWindowProc
If Application.Visible = False Then
'//使主窗体可见
Application.Visible = True
'//重绘主窗体标题栏
DrawMenuBar xlHwnd
'//活动窗口最大化，如在重绘窗体前最大化则会使主窗体的标题栏无法显示活动窗口的标题
ActiveWindow.WindowState = xlMaximized
'//清除标识
MyData.uFlags = 0
'//删除图标
Shell_NotifyIcon NIM_DELETE, MyData
End If
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------
'//"退出Excel"菜单调用程序
Sub QuitExcel()
'//恢复主窗体消息过程
SetWindowLong xlHwnd, 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:" & "wangminbai1978@163.com" & "?subject=关于添加托盘图标", vbNullString, vbNullString, 0
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------
'//"OFFICEFANS"菜单调用程序
Sub OpenNet()
ShellExecute 0, "open", "http://Club.officefans.net", vbNullString, vbNullString, 0
End Sub
最小化Excel 至系统托盘（7）
2007-12-12 15:13
ThisWorkbook中代码：
'//****************************************************************************************************************************************
'//此模块主要是在文档打开时创建用于托盘图标右键的快捷菜单，在文档关闭时删除此菜单
'//****************************************************************************************************************************************
'//——以下定义变量——
Private ButtonReturn As CommandBarButton, ButtonQuit As CommandBarButton
Private ButtonAuthor As CommandBarButton, ButtonOffice As CommandBarButton
'//****************************************************************************************************************************************
'//文档关闭前执行
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
'//删除建立的快捷菜单
NewBar.Delete
On Error GoTo 0
End Sub
'//------------------------------------------------------------------------------------------------------------------------------------------------------------
'//****************************************************************************************************************************************
'//文档打开时执行
Private Sub Workbook_Open()
'//去除主窗体最小化按钮
Call DelMinimizeBox
'//建立新的快捷菜单，此菜单将用于托盘图标
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 = "OFFICEFANS"
.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
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------
'//****************************************************************************************************************************************
'//工作簿窗口调整大小时产生此事件
Private Sub Workbook_WindowResize(ByVal Wn As Window)
If Application.ActiveWindow.WindowState = xlMinimized Then
'//最小化至系统托盘
Call hideHwnd
End If
End Sub