关于清空Office剪切板的方法

关于清空Office剪切板的方法问题，原来好像就有很多的讨论。

1、有的大虾认为使用 

Application.CutCopyMode  =   False

 就可以了。其实不然，这只是取消剪切或复制模式并清除移动边框。并没有真正的清除剪切板上的数据。数据还是存在的。

2、使用API函数程序，代码如下：

Private   Declare   Function  apiOpenClipboard  Lib   " user32 "   Alias   " OpenClipboard "  ( ByVal  hwnd  As   Long )  As   Long
Private   Declare   Function  apiEmptyClipboard  Lib   " user32 "   Alias   " EmptyClipboard "  ()  As   Long
Private   Declare   Function  apiCloseClipboard  Lib   " user32 "   Alias   " CloseClipboard "  ()  As   Long
Sub  myClr()  
    apiOpenClipboard ( 0 ) ' 打开剪切板
    apiEmptyClipboard ' 清空剪切板
    apiCloseClipboard ' 关闭剪切板
End Sub

但是你会发现使用这段程序也不会清空Office的剪切板，这是因为Windows不会参与剪切板私有数据的管理。

3、前一段时间我看到一段代码，是用来清空Office的剪切板的，代码如下：

' ---------------------------------------------------------------------------------------
'  Module     : Module1
'  DateTime : 12/4/2006 11:23
'  Author     : keepITcool , http://www.mrexcel.com/board2/viewtopic.php?t=143291                    
'  Purpose    : Clear Windows and Office Clipboards
' ---------------------------------------------------------------------------------------
Private   Declare   Function  apiOpenClipboard  Lib   " user32 "   Alias   " OpenClipboard "  ( ByVal  hwnd  As   Long )  As   Long
Private   Declare   Function  apiEmptyClipboard  Lib   " user32 "   Alias   " EmptyClipboard "  ()  As   Long
Private   Declare   Function  apiCloseClipboard  Lib   " user32 "   Alias   " CloseClipboard "  ()  As   Long
Private   Declare   Sub  Sleep  Lib   " kernel32.dll "  ( ByVal  dwMilliseconds  As   Long )
Private   Declare   Function  FindWindowEx  Lib   " user32.dll "  _
     Alias   " FindWindowExA "  ( ByVal  hWnd1  As   Long , _
     ByVal  hWnd2  As   Long ,  ByVal  lpsz1  As   String , _
     ByVal  lpsz2  As   String )  As   Long
Private   Declare   Function  PostMessage  Lib   " user32.dll "   Alias  _
     " PostMessageA "  ( ByVal  hwnd  As   Long ,  ByVal  wMsg  As   Long , _
     ByVal  wParam  As   Long ,  ByVal  lParam  As   Long )  As   Long
Private   Const  WM_LBUTTONDOWN  As   Long   =   & H201 &
Private   Const  WM_LBUTTONUP  As   Long   =   & H202 &

'  Creates a long variable out of two words
Private   Function  MakeLong( ByVal  nLoWord  As   Integer ,  ByVal  nHiWord  As   Integer )  As   Long
     MakeLong  =  nHiWord  *   65536   +  nLoWord
End Function


Sub  ClearOfficeClipboard()
Dim  hMain & , hExcel2 & , hClip & , hWindow & , hParent &
Dim  lParameter & , sTask$

sTask  =  Application.CommandBars( " Task Pane " ).NameLocal

'  Handle for XLMAIN
hMain  =  Application.hwnd

'  Find the OfficeClipboard Window
'  2 methods as we're not sure if it's visible
'  ONCE it has been made visible the windowclass is created
'  and remains loaded for the duration of the instance
Do
     hExcel2  =  FindWindowEx(hMain, hExcel2,  " EXCEL2 " , vbNullString)
     hParent  =  hExcel2: hWindow  =   0
     hWindow  =  FindWindowEx(hParent, hWindow,  " MsoCommandBar " , sTask)
     If  hWindow  Then
         hParent  =  hWindow: hWindow  =   0
         hWindow  =  FindWindowEx(hParent, hWindow,  " MsoWorkPane " , vbNullString)
         If  hWindow  Then
             hParent  =  hWindow: hWindow  =   0
             hClip  =  FindWindowEx(hParent, hWindow,  " bosa_sdm_XL9 " , vbNullString)
             If  hClip  >   0   Then
                 Exit   Do
             End   If
         End   If
     End   If
Loop   While  hExcel2  >   0

If  hClip  =   0   Then
     hParent  =  hMain: hWindow  =   0
     hWindow  =  FindWindowEx(hParent, hWindow,  " MsoWorkPane " , vbNullString)
     If  hWindow  Then
         hParent  =  hWindow: hWindow  =   0
         hClip  =  FindWindowEx(hParent, hWindow,  " bosa_sdm_XL9 " , vbNullString)
     End   If
End   If

If  hClip  =   0   Then
     ClipWindowForce
     hParent  =  hMain: hWindow  =   0
     hWindow  =  FindWindowEx(hParent, hWindow,  " MsoWorkPane " , vbNullString)
     If  hWindow  Then
         hParent  =  hWindow: hWindow  =   0
         hClip  =  FindWindowEx(hParent, hWindow,  " bosa_sdm_XL9 " , vbNullString)
     End   If
End   If


If  hClip  =   0   Then
     MsgBox   " Cant find Clipboard window "
     Exit Sub
End   If

lParameter  =  MakeLong( 120 ,  18 )
Call  PostMessage(hClip, WM_LBUTTONDOWN,  0 & , lParameter)
Call  PostMessage(hClip, WM_LBUTTONUP,  0 & , lParameter)
Sleep  100
DoEvents

End Sub

Sub  ClipWindowForce()
Dim  octl
With  Application.CommandBars( " Task Pane " )
     If   Not  .Visible  Then
         Application.ScreenUpdating  =   False
         Set  octl  =  Application.CommandBars( 1 ).FindControl(ID: = 809 , recursive: = True )
         If   Not  octl  Is   Nothing   Then  octl.Execute
         .Visible  =   False
         Application.ScreenUpdating  =   True
     End   If
End   With
End Sub

'  Main program to clear Windows and Office Clipboards

Sub  myClr()  

Call  ClearOfficeClipboard
apiOpenClipboard ( 0 )
apiEmptyClipboard
apiCloseClipboard
Application.CutCopyMode  =   False

End Sub

      代码的基本原理是找到剪切板窗体的句柄，然后向窗体发送一个在“全部清空”这个按钮的位置点击鼠标左键的消息，以此来清空剪切板。一开始我对这段代码进行了检测，发现他很有效果，真的可以清空Office的剪切板。并把它转载到了我的博客。但是后来我发现当剪切板的位置变为横放或者Office剪切板的大小发生变化导致“全部清空”的位置发生变化更有可能导致“全部清空”按钮不可见时，此代码就不能清空Office的剪切板（前两种情况可以用判断一下Office大小及位置的方法来发送消息来解决，但Office剪切板"全部清空"按钮不可见时就不好弄了）。

      可见以上的方法都不完美，不能真正的清空Office剪切板。

      前一段时间在网上找到一个小工具，名叫AccExplorer32，这个工具却可以取得Office剪切板中按钮的位置、名称等各种信息并可以对按钮进行操作。对这个东西的具体操作原理很感兴趣。但是到网上进行各种搜索都没有发现具体的实现方法。最近到网上下载了一本电子书籍名叫《Advanced Microsoft Visual Basic 6.0 Second Edition》电子书。在其中的第16章中有名叫Microsoft Active Accessibility的一节，看到之后才明白了其中的奥妙。这一节就描述怎样在VB中使用Accessibility界面。真是赶到非常的高兴。赶紧试着使用了一下。发现使用微软的Active Accessibility就可以找到“全部清空”按钮并执行它，进而达到清空Office剪切板的目的。以下就是我使用Active Accessibility来清空剪切板的代码，大家共享：

Option   Explicit
' |---------------------------------------------------------------------------------------|
' |Module     : ClearOfficeClipboard                                                      |
' |DateTime   : 2008-4-24                                                                 |
' |Author     : wangmingbai , http://www.officefans.net/cdb/forumdisplay.php?fid=1        |
' |Purpose    : Clear Windows and Office Clipboards                                       |
' |---------------------------------------------------------------------------------------|
' |--------------------------------------------------|
' |--------------声明API函数-------------------------|
' |--------------------------------------------------|
' --------------查找指定窗口的子窗口---------------
Private   Declare   Function  FindWindowEx _
     Lib   " user32.dll "  _
     Alias   " FindWindowExA "  ( _
         ByVal  hWnd1  As   Long , _
         ByVal  hWnd2  As   Long ,  ByVal  lpsz1  As   String , _
         ByVal  lpsz2  As   String ) _
As   Long
' --------------从窗口返回Accessible对象---------------
Private   Declare   Function  AccessibleObjectFromWindow _
     Lib   " oleacc "  ( _
         ByVal  hwnd  As   Long , _
         ByVal  dwId  As   Long , _
        riid  As  tGUID, _
        ppvObject  As   Object ) _
As   Long
' --------------取得Accessible的子对象---------------
Private   Declare   Function  AccessibleChildren _
     Lib   " oleacc "  ( _
         ByVal  paccContainer  As  IAccessible, _
         ByVal  iChildStart  As   Long , _
         ByVal  cChildren  As   Long , _
        rgvarChildren  As  Variant, _
        pcObtained  As   Long ) _
As   Long
' --------------锁定指定窗口，禁止它更新------------
Private   Declare   Function  LockWindowUpdate _
     Lib   " user32 "  ( _
         ByVal  hwndLock  As   Long ) _
As   Long
' |--------------------------------------------------|
' |-----------------声明类型-------------------------|
' |--------------------------------------------------|
Private  Type tGUID
    lData1             As   Long
    nData2             As   Integer
    nData3             As   Integer
    abytData4( 0   To   7 )  As   Byte
End  Type
' |--------------------------------------------------|
' |-----------------定义常量-------------------------|
' |--------------------------------------------------|
Private   Const  ROLE_PUSHBUTTON  =   & H2B &
' |*************************************************************|
' |**********************主程序，用于清除Office剪切板***********|
' |*************************************************************|
Sub  ClearOfficeClipboard()

     ' |--------------------------------------------------|
     ' |----------------以下部分定义变量------------------|
     ' |--------------------------------------------------|
     Dim  hMain         As   Long
     Dim  hExcel2       As   Long
     Dim  hClip         As   Long
     Dim  hWindow       As   Long
     Dim  hParent       As   Long
     Dim  lParameter    As   Long
     Dim  octl          As  CommandBarControl
     Dim  oIA           As  IAccessible
     Dim  oNewIA        As  IAccessible
     Dim  tg            As  tGUID
     Dim  lReturn       As   Long
     Dim  lStart        As   Long
     Dim  avKids()      As  Variant
     Dim  avMoreKids()  As  Variant
     Dim  lHowMany      As   Long
     Dim  lGotHowMany   As   Long
     Dim  bClip         As   Boolean
     Dim  i             As   Long
     Dim  hVersion      As   Long
    
    
     ' |--------------------------------------------------|
     ' |-----------以下部分用于取得剪切板窗口句柄---------|
     ' |--------------------------------------------------|
    
     ' /--取得Office程序的主窗体句柄
    hMain  =  Application.hwnd

     ' /取得Excel的版本
    hVersion  =  Application.Version

     ' /假如Excel版本是2000及其以下版本
     If  hVersion  <   10   Then   MsgBox   " 此程序不支持Excel2000及其以下版本 " :  Exit Sub
    
     ' /假如Excel版本为2007版且剪切板不可见时使其可见
     If  hVersion  =   12   Then
        bClip  =   True
         With  Application.CommandBars( " Office Clipboard " )
             If   Not  .Visible  Then
                LockWindowUpdate hMain
                bClip  =   False
                 Set  octl  =  Application.CommandBars( 1 ).FindControl(ID: = 809 , recursive: = True )
                 If   Not  octl  Is   Nothing   Then  octl.Execute
             End   If
         End   With
     End   If
    
     ' /用于取得剪切板窗口的句柄（剪切板窗口可见时）
     Do
         hExcel2  =  FindWindowEx(hMain, hExcel2,  " EXCEL2 " , vbNullString)
         hParent  =  hExcel2: hWindow  =   0
         hWindow  =  FindWindowEx(hParent, hWindow,  " MsoCommandBar " , vbNullString)
         If  hWindow  Then
             hParent  =  hWindow: hWindow  =   0
             hWindow  =  FindWindowEx(hParent, hWindow,  " MsoWorkPane " , vbNullString)
             If  hWindow  Then
                 hParent  =  hWindow: hWindow  =   0
                 hClip  =  FindWindowEx(hParent, hWindow,  " bosa_sdm_XL9 " ,  " Collect and Paste 2.0 " )
                 If  hClip  >   0   Then
                     Exit   Do
                 End   If
             End   If
         End   If
     Loop   While  hExcel2  >   0
     ' /取得剪切板窗口的句柄（剪切板窗口不可见时,2003及XP版本调用）
     If  hClip  =   0   Then
         hParent  =  hMain: hWindow  =   0
         hWindow  =  FindWindowEx(hParent, hWindow,  " MsoWorkPane " , vbNullString)
         If  hWindow  Then
             hParent  =  hWindow: hWindow  =   0
             hClip  =  FindWindowEx(hParent, hWindow,  " bosa_sdm_XL9 " ,  " Collect and Paste 2.0 " )
         End   If
     End   If
     ' /取得剪切板窗口的句柄（剪切板窗口未初始化,2003及XP版本调用）
     If  hClip  =   0   Then
         With  Application.CommandBars( " Task Pane " )
             If   Not  .Visible  Then
                LockWindowUpdate hMain
                 Set  octl  =  Application.CommandBars( 1 ).FindControl(ID: = 809 , recursive: = True )
                 If   Not  octl  Is   Nothing   Then  octl.Execute
                .Visible  =   False
                LockWindowUpdate  0
             End   If
         End   With
        hParent  =  hMain: hWindow  =   0
        hWindow  =  FindWindowEx(hParent, hWindow,  " MsoWorkPane " , vbNullString)
         If  hWindow  Then
             hParent  =  hWindow: hWindow  =   0
             hClip  =  FindWindowEx(hParent, hWindow,  " bosa_sdm_XL9 " ,  " Collect and Paste 2.0 " )
         End   If
     End   If
     ' /即如以上都未找到剪切板窗口，显示错误信息
     If  hClip  =   0   Then
         MsgBox   " 剪切板窗口未找到 "
         Exit Sub
     End   If
    
    
     ' |--------------------------------------------------|
     ' |------以下部分用于取得"全部清空"按钮并执行它------|
     ' |--------------------------------------------------|
    
     ' 以下部分代码参考了《Advanced Microsoft Visual Basic 6.0 Second Edition》第16章Microsoft Active Accessibility部分
     ' 定义IAccessible对象的GUID{618736E0-3C3D-11CF-810C-00AA00389B71}
     With  tg
        .lData1  =   & H618736E0
        .nData2  =   & H3C3D
        .nData3  =   & H11CF
        .abytData4( 0 )  =   & H81
        .abytData4( 1 )  =   & HC
        .abytData4( 2 )  =   & H0
        .abytData4( 3 )  =   & HAA
        .abytData4( 4 )  =   & H0
        .abytData4( 5 )  =   & H38
        .abytData4( 6 )  =   & H9B
        .abytData4( 7 )  =   & H71
     End   With
     ' /从窗体返回Accessible对象
    lReturn  =  AccessibleObjectFromWindow(hClip,  0 , tg, oIA)
    lStart  =   0
     ' /取得Accessible的子对象数量
    lHowMany  =  oIA.accChildCount
     ReDim  avKids(lHowMany  -   1 )  As  Variant
    lGotHowMany  =   0
     ' /返回Accessible的子对象
    lReturn  =  AccessibleChildren(oIA, lStart, lHowMany, avKids( 0 ), lGotHowMany)
     For  i  =   0   To  lGotHowMany  -   1
         If  IsObject(avKids(i))  =   True   Then
             If  avKids(i).accName  =   " Collect and Paste 2.0 "   Then
                 Set  oNewIA  =  avKids(i)
                lHowMany  =  oNewIA.accChildCount
                 Exit   For
             End   If
         End   If
     Next  i
     ReDim  avMoreKids(lHowMany  -   1 )  As  Variant
    lReturn  =  AccessibleChildren(oNewIA, lStart, lHowMany, avMoreKids( 0 ), lGotHowMany)
     ' 取得"全部清空"按钮并执行它
     For  i  =   0   To  lHowMany  -   1
         If  IsObject(avMoreKids(i))  =   False   Then
             If  oNewIA.accName(avMoreKids(i))  =   " 全部清空 "   And  oNewIA.accRole(avMoreKids(i))  =  ROLE_PUSHBUTTON  Then
                oNewIA.accDoDefaultAction (avMoreKids(i))
                 Exit   For
             End   If
         End   If
     Next  i
    
     ' /如果原来Excel版本为12且剪切板不可见则恢复它
     If  hVersion  =   12   And  bClip  =   False   Then  Application.CommandBars( " Office Clipboard " ).Visible  =  bClip: LockWindowUpdate  0
    
End Sub

这个代码的原理是首先找到Office剪切板的句柄，然后通过 Microsoft Active Accessibility来取得“全部清空”按钮并执行它，从而清空了剪切板。这也就避免了前面第3种方法的局限性。

以上言论纯属抛砖引玉，那位大侠有更好的办法望共享。

备注：今天发现原来的代码不支持Excel2007版，所以对代码作了一定的修改，使其可以支持清空2007版Excel的剪切板了。------wangminbai 2008-4-26