清空剪切板代码

gdw831001 · 发表于 2015-7-18 00:37

这段代码来之我们EH论谈wangminbai这位老师的博客，
以前找了好多代码都不能把剪切板清空掉，正如wangminbai老师在博客中所说，把这个代码留下以后备用吧，也许有人也在找这样的代码。
谢谢wangminbai老师。

Option Explicit
'********************************************************
'Module : ClearOfficeClipboard
'DateTime : 2008-4-24
'Author : Mars , http://www.excelfans.com
'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()
' 以下部分定义变量
100
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 "剪切板窗口未找到"
GoTo 100
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
If Not octl Is Nothing Then octl.Execute
End Sub

复制代码

liucqa · 发表于 2015-7-18 15:37

二楼是清空系统剪贴板，一楼代码是清空office剪贴板

huang1314wei · 发表于 2015-7-18 06:03

Sub text()
Shell "C:\Windows\System32\cmd.exe " & "cmd /c @echo off | clip"
End Sub

复制代码

楼主，直接调用cmd命令好像也可以清空剪切板吧

gdw831001 · 发表于 2015-7-18 10:23

huang1314wei 发表于 2015-7-18 06:03
楼主，直接调用cmd命令好像也可以清空剪切板吧

在我07与10版下测试这个方法没有用

huang1314wei · 发表于 2015-7-18 10:39

gdw831001 发表于 2015-7-18 10:23
在我07与10版下测试这个方法没有用

我在我的电脑上10版测试是有用的

gdw831001 · 发表于 2015-7-18 10:45

huang1314wei 发表于 2015-7-18 10:39
我在我的电脑上10版测试是有用的

可能是我10与07是盗版的吧，要么就是系统问题，，这些都无所谓了，如果有人找这样的功能时，看到这些贴子，也许对他们都有用，，以前我就是找这清空剪切板，找了好多代码都没有解决，昨天无意中看到了wangminbai老师的代码，然后在我这测试有用。就留下以后备用吧。

huang1314wei · 发表于 2015-7-18 11:11

gdw831001 发表于 2015-7-18 10:45
可能是我10与07是盗版的吧，要么就是系统问题，，这些都无所谓了，如果有人找这样的功能时，看到这些贴子 ...

嗯，看了一下代码，该考虑的都考虑了，确实比较完美

gdw831001 · 发表于 2015-7-18 23:13

liucqa 发表于 2015-7-18 15:37
二楼是清空系统剪贴板，一楼代码是清空office剪贴板

谢谢老师指点

浮华、缠绕指尖 · 发表于 2015-7-18 23:28

又看见这个了，其实百度就能找到的，前不久我还用这个做过一个自定义函数，专门取office上的剪切板的条目

Ironthree · 发表于 2017-5-5 00:28

感谢分享，终于找到可以用的代码了。WIN8+EXCEL2010，感谢gdw831001，感谢wangminbai老师。

		自动登录	找回密码
密码			免费注册

[分享] 清空剪切板代码

评分

浏览过的版块