Hook运用之最小化Excel到系统托盘

    很多的软件点击最小化按钮后都可以最小化到系统的托盘区域，然后在托盘区域点击图标可以返回程序或者进行更多的操作。但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

详见附件：
点击下载

转载于:https://www.cnblogs.com/wangminbai/archive/2008/03/10/1099126.html