如何清空 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
' 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
'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 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版本是2000及其以下版本
hVersion = Application.Version
If hVersion < 10 Then
MsgBox "此程序不支持Excel2000及其以下版本"
Exit Sub
End If
'假如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 If
End Sub
这个代码的原理是首先找到Office剪切板的句柄，然后通过Microsoft Active Accessibility来取得“全部清空”按钮并执行它，从而清空了剪切板。这也就避免了前面第3种方法的局限性。
