最小化Excel 至系统托盘

在很多的程序中当我们点击程序的最小化按钮时程序就会最小化至系统的托盘中，而且在最小化至系统托盘时会显示一个气球信息。当我们点击托盘中的图标或点击鼠标右键菜单时程序就会还原。比如金山词霸等软件，那我们在Excel 中能实现这种功能吗？可以的，现在就试一试：

l         在Excel 的VBE窗口中添加一个模块，在此模块和ThisWorkbook中添加后面所列代码

l         在表格中添加一窗体按钮，并将其宏设置为 Example。此供示范之用。具体见附件。
    
模块中代码：

' //*******************************************************************************************************************
' //此模块的主要实现点击最小化图标后是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
' //——以下定义常数及类型——
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                ' 用于寄存新建的快捷菜单
' //****************************************************************************************************************************************
' //隐藏主窗体及添加托盘图标
' //****************************************************************************************************************************************
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
' //****************************************************************************************************************************************
' //回调函数
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
' //****************************************************************************************************************************************
' //以下过程为工作表中按钮调用
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: "   &   " 758237@qq.com "   &   " ?subject=关于添加托盘图标 " , vbNullString, vbNullString,  0
End Sub
' //----------------------------------------------------------------------------------------------------------------------------------------
' //"我的博客"菜单调用程序
Sub  OpenNet()
    ShellExecute  0 ,  " open " ,  " http://www.cnblogs.com/wangminbai/ " , vbNullString, vbNullString,  0
End Sub
' //----------------------------------------------------------------------------------------------------------------------------------------

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  =   " 我的博客 "
            .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
' //----------------------------------------------------------------------------------------------------------------------------------------

 

转载于:https://www.cnblogs.com/wangminbai/archive/2008/02/20/1075469.html