ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 我的酷贴 > Excel VBA > 关于清空Office的剪切板

关于清空Office的剪切板

作者：绿色风 分类： 时间：2022-08-18 浏览：84
楼主
omnw		 关于清空Office剪切板的方法问题，原来好像就有很多的讨论。
1、有的大虾认为使用
  1. Application.CutCopyMode = False

就可以了。其实不然，这只是取消剪切或复制模式并清除移动边框。并没有真正的清除剪切板上的数据。数据还是存在的。
2、使用API函数程序，代码如下：
  1. Private Declare Function apiOpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal hwnd As Long) As Long
  2. Private Declare Function apiEmptyClipboard Lib "user32" Alias "EmptyClipboard" () As Long
  3. Private Declare Function apiCloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
  4. Sub myClr()  
  5.     apiOpenClipboard (0)'打开剪切板
  6.     apiEmptyClipboard'清空剪切板
  7.     apiCloseClipboard'关闭剪切板
  8. End Sub

复制代码但是你会发现使用这段程序也不会清空Office的剪切板，这是因为Windows不会参与剪切板私有数据的管理。
3、前一段时间我看到一段代码，是用来清空Office的剪切板的，代码如下：
  1. '→→→→→→→→→→→→→→→→→→→→→→→→→→→→→
  2. ' Module     : Module1
  3. ' DateTime : 12/4/2006 11:23
  4. ' Author     : keepITcool , http://www.mrexcel.com/board2/viewtopic.php?t=143291               
  5. ' Purpose    : Clear Windows and Office Clipboards
  6. '→→→→→→→→→→→→→→→→→→→→→→→→→→→→→
  7. Private Declare Function apiOpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal hwnd As Long) As Long
  8. Private Declare Function apiEmptyClipboard Lib "user32" Alias "EmptyClipboard" () As Long
  9. Private Declare Function apiCloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
  10. Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
  11. Private Declare Function FindWindowEx Lib "user32.dll" _
  12.     Alias "FindWindowExA" (ByVal hWnd1 As Long, _
  13.     ByVal hWnd2 As Long, ByVal lpsz1 As String, _
  14.     ByVal lpsz2 As String) As Long
  15. Private Declare Function PostMessage Lib "user32.dll" Alias _
  16.     "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
  17.     ByVal wParam As Long, ByVal lParam As Long) As Long
  18. Private Const WM_LBUTTONDOWN As Long = &H201&
  19. Private Const WM_LBUTTONUP As Long = &H202&
  20. ' Creates a long variable out of two words
  21. Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Long
  22.      MakeLong = nHiWord * 65536 + nLoWord
  23. End Function
  24. Sub ClearOfficeClipboard()
  25. Dim hMain&, hExcel2&, hClip&, hWindow&, hParent&
  26. Dim lParameter&, sTask$
  27. sTask = Application.CommandBars("Task Pane").NameLocal
  28. ' Handle for XLMAIN
  29. hMain = Application.hwnd
  30. ' Find the OfficeClipboard Window
  31. ' 2 methods as we're not sure if it's visible
  32. ' ONCE it has been made visible the windowclass is created
  33. ' and remains loaded for the duration of the instance
  34. Do
  35.      hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)
  36.      hParent = hExcel2: hWindow = 0
  37.      hWindow = FindWindowEx(hParent, hWindow, "MsoCommandBar", sTask)
  38.     If hWindow Then
  39.          hParent = hWindow: hWindow = 0
  40.          hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
  41.         If hWindow Then
  42.              hParent = hWindow: hWindow = 0
  43.              hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
  44.             If hClip > 0 Then
  45.                 Exit Do
  46.             End If
  47.         End If
  48.     End If
  49. Loop While hExcel2 > 0
  50. If hClip = 0 Then
  51.      hParent = hMain: hWindow = 0
  52.      hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
  53.     If hWindow Then
  54.          hParent = hWindow: hWindow = 0
  55.          hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
  56.     End If
  57. End If
  58. If hClip = 0 Then
  59.      ClipWindowForce
  60.      hParent = hMain: hWindow = 0
  61.      hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
  62.     If hWindow Then
  63.          hParent = hWindow: hWindow = 0
  64.          hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
  65.     End If
  66. End If
  67. If hClip = 0 Then
  68.     MsgBox "Cant find Clipboard window"
  69.     Exit Sub
  70. End If
  71. lParameter = MakeLong(120, 18)
  72. Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
  73. Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
  74. Sleep 100
  75. DoEvents
  76. End Sub
  77. Sub ClipWindowForce()
  78. Dim octl
  79. With Application.CommandBars("Task Pane")
  80.     If Not .Visible Then
  81.          Application.ScreenUpdating = False
  82.         Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
  83.         If Not octl Is Nothing Then octl.Execute
  84.          .Visible = False
  85.          Application.ScreenUpdating = True
  86.     End If
  87. End With
  88. End Sub
  89. ' Main program to clear Windows and Office Clipboards
  90. Sub myClr()  
  91. Call ClearOfficeClipboard
  92. apiOpenClipboard (0)
  93. apiEmptyClipboard
  94. apiCloseClipboard
  95. Application.CutCopyMode = False
  96. 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来清空剪切板的代码，大家共享：
  1. Option Explicit
  2. '|→→→→→→→→→→→→→→→→→→→→→→→→→→→→→|
  3. '|Module     : ClearOfficeClipboard                                                      |
  4. '|DateTime   : 2008-4-24                                                                 |
  5. '|Author     : wangmingbai , http://www.officefans.net/cdb/forumdisplay.php?fid=1        |
  6. '|Purpose    : Clear Windows and Office Clipboards                                       |
  7. '|→→→→→→→→→→→→→→→→→→→→→→→→→→→→→|
  8. '|→→→→→→→→→→→→→→→→--|
  9. '|→→→→--声明API函数→→→→→→→→-|
  10. '|→→→→→→→→→→→→→→→→--|
  11. '→→→→--查找指定窗口的子窗口→→→→→
  12. Private Declare Function FindWindowEx _
  13.     Lib "user32.dll" _
  14.     Alias "FindWindowExA" ( _
  15.         ByVal hWnd1 As Long, _
  16.         ByVal hWnd2 As Long, ByVal lpsz1 As String, _
  17.         ByVal lpsz2 As String) _
  18. As Long
  19. '→→→→--从窗口返回Accessible对象→→→→→
  20. Private Declare Function AccessibleObjectFromWindow _
  21.     Lib "oleacc" ( _
  22.         ByVal hwnd As Long, _
  23.         ByVal dwId As Long, _
  24.         riid As tGUID, _
  25.         ppvObject As Object) _
  26. As Long
  27. '→→→→--取得Accessible的子对象→→→→→
  28. Private Declare Function AccessibleChildren _
  29.     Lib "oleacc" ( _
  30.         ByVal paccContainer As IAccessible, _
  31.         ByVal iChildStart As Long, _
  32.         ByVal cChildren As Long, _
  33.         rgvarChildren As Variant, _
  34.         pcObtained As Long) _
  35. As Long
  36. '→→→→--锁定指定窗口，禁止它更新→→→→
  37. Private Declare Function LockWindowUpdate _
  38.     Lib "user32" ( _
  39.         ByVal hwndLock As Long) _
  40. As Long
  41. '|→→→→→→→→→→→→→→→→--|
  42. '|→→→→→--声明类型→→→→→→→→-|
  43. '|→→→→→→→→→→→→→→→→--|
  44. Private Type tGUID
  45.     lData1            As Long
  46.     nData2            As Integer
  47.     nData3            As Integer
  48.     abytData4(0 To 7) As Byte
  49. End Type
  50. '|→→→→→→→→→→→→→→→→--|
  51. '|→→→→→--定义常量→→→→→→→→-|
  52. '|→→→→→→→→→→→→→→→→--|
  53. Private Const ROLE_PUSHBUTTON = &H2B&
  54. '|*************************************************************|
  55. '|**********************主程序，用于清除Office剪切板***********|
  56. '|*************************************************************|
  57. Sub ClearOfficeClipboard()
  58.     '|→→→→→→→→→→→→→→→→--|
  59.     '|→→→→→-以下部分定义变量→→→→→→|
  60.     '|→→→→→→→→→→→→→→→→--|
  61.     Dim hMain        As Long
  62.     Dim hExcel2      As Long
  63.     Dim hClip        As Long
  64.     Dim hWindow      As Long
  65.     Dim hParent      As Long
  66.     Dim octl         As CommandBarControl
  67.     Dim oIA          As IAccessible
  68.     Dim oNewIA       As IAccessible
  69.     Dim tg           As tGUID
  70.     Dim lReturn      As Long
  71.     Dim lStart       As Long
  72.     Dim avKids()     As Variant
  73.     Dim avMoreKids() As Variant
  74.     Dim lHowMany     As Long
  75.     Dim lGotHowMany  As Long
  76.     Dim bClip        As Boolean
  77.     Dim i            As Long
  78.     Dim hVersion     As Long
  79.    
  80.    
  81.     '|→→→→→→→→→→→→→→→→--|
  82.     '|→→→--以下部分用于取得剪切板窗口句柄→→→|
  83.     '|→→→→→→→→→→→→→→→→--|
  84.    
  85.     '/--取得Office程序的主窗体句柄
  86.     hMain = Application.hwnd
  87.     '/取得Excel的版本
  88.     hVersion = Application.Version
  89.     '/假如Excel版本是2000及其以下版本
  90.     If hVersion < 10 Then MsgBox "此程序不支持Excel2000及其以下版本": Exit Sub
  91.    
  92.     '/假如Excel版本为2007版且剪切板不可见时使其可见
  93.     If hVersion = 12 Then
  94.         bClip = True
  95.         With Application.CommandBars("Office Clipboard")
  96.             If Not .Visible Then
  97.                 LockWindowUpdate hMain
  98.                 bClip = False
  99.                 Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
  100.                 If Not octl Is Nothing Then octl.Execute
  101.             End If
  102.         End With
  103.     End If
  104.    
  105.     '/用于取得剪切板窗口的句柄（剪切板窗口可见时）
  106.     Do
  107.          hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)
  108.          hParent = hExcel2: hWindow = 0
  109.          hWindow = FindWindowEx(hParent, hWindow, "MsoCommandBar", vbNullString)
  110.         If hWindow Then
  111.              hParent = hWindow: hWindow = 0
  112.              hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
  113.             If hWindow Then
  114.                  hParent = hWindow: hWindow = 0
  115.                  hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", "Collect and Paste 2.0")
  116.                 If hClip > 0 Then
  117.                     Exit Do
  118.                 End If
  119.             End If
  120.         End If
  121.     Loop While hExcel2 > 0
  122.     '/取得剪切板窗口的句柄（剪切板窗口不可见时,2003及XP版本调用）
  123.     If hClip = 0 Then
  124.          hParent = hMain: hWindow = 0
  125.          hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
  126.         If hWindow Then
  127.              hParent = hWindow: hWindow = 0
  128.              hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", "Collect and Paste 2.0")
  129.         End If
  130.     End If
  131.     '/取得剪切板窗口的句柄（剪切板窗口未初始化,2003及XP版本调用）
  132.     If hClip = 0 Then
  133.         With Application.CommandBars("Task Pane")
  134.             If Not .Visible Then
  135.                 LockWindowUpdate hMain
  136.                 Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
  137.                 If Not octl Is Nothing Then octl.Execute
  138.                 .Visible = False
  139.                 LockWindowUpdate 0
  140.             End If
  141.         End With
  142.         hParent = hMain: hWindow = 0
  143.         hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
  144.         If hWindow Then
  145.              hParent = hWindow: hWindow = 0
  146.              hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", "Collect and Paste 2.0")
  147.         End If
  148.     End If
  149.     '/即如以上都未找到剪切板窗口，显示错误信息
  150.     If hClip = 0 Then
  151.         MsgBox "剪切板窗口未找到"
  152.         Exit Sub
  153.     End If
  154.    
  155.    
  156.     '|→→→→→→→→→→→→→→→→--|
  157.     '|→→以下部分用于取得"全部清空"按钮并执行它→→|
  158.     '|→→→→→→→→→→→→→→→→--|
  159.    
  160.     '以下部分代码参考了《Advanced Microsoft Visual Basic 6.0 Second Edition》第16章Microsoft Active Accessibility部分
  161.     '定义IAccessible对象的GUID{618736E0-3C3D-11CF-810C-00AA00389B71}
  162.     With tg
  163.         .lData1 = &H618736E0
  164.         .nData2 = &H3C3D
  165.         .nData3 = &H11CF
  166.         .abytData4(0) = &H81
  167.         .abytData4(1) = &HC
  168.         .abytData4(2) = &H0
  169.         .abytData4(3) = &HAA
  170.         .abytData4(4) = &H0
  171.         .abytData4(5) = &H38
  172.         .abytData4(6) = &H9B
  173.         .abytData4(7) = &H71
  174.     End With
  175.     '/从窗体返回Accessible对象
  176.     lReturn = AccessibleObjectFromWindow(hClip, 0, tg, oIA)
  177.     lStart = 0
  178.     '/取得Accessible的子对象数量
  179.     lHowMany = oIA.accChildCount
  180.     ReDim avKids(lHowMany - 1) As Variant
  181.     lGotHowMany = 0
  182.     '/返回Accessible的子对象
  183.     lReturn = AccessibleChildren(oIA, lStart, lHowMany, avKids(0), lGotHowMany)
  184.     For i = 0 To lGotHowMany - 1
  185.         If IsObject(avKids(i)) = True Then
  186.             If avKids(i).accName = "Collect and Paste 2.0" Then
  187.                 Set oNewIA = avKids(i)
  188.                 lHowMany = oNewIA.accChildCount
  189.                 Exit For
  190.             End If
  191.         End If
  192.     Next i
  193.     ReDim avMoreKids(lHowMany - 1) As Variant
  194.     lReturn = AccessibleChildren(oNewIA, lStart, lHowMany, avMoreKids(0), lGotHowMany)
  195.     '取得"全部清空"按钮并执行它
  196.     For i = 0 To lHowMany - 1
  197.         If IsObject(avMoreKids(i)) = False Then
  198.             If oNewIA.accName(avMoreKids(i)) = "全部清空" And oNewIA.accRole(avMoreKids(i)) = ROLE_PUSHBUTTON Then
  199.                 oNewIA.accDoDefaultAction (avMoreKids(i))
  200.                 Exit For
  201.             End If
  202.         End If
  203.     Next i
  204.    
  205.     '/如果原来Excel版本为12且剪切板不可见则恢复它
  206.     If hVersion = 12 And bClip = False Then Application.CommandBars("Office Clipboard").Visible = bClip: LockWindowUpdate 0
  207.    
  208. End Sub

       这个代码的原理是首先找到Office剪切板的句柄，然后通过Microsoft Active Accessibility来取得“全部清空”按钮并执行它，从而清空了剪切板。这也就避免了前面第3种方法的局限性。
以上言论纯属抛砖引玉，那位大侠有更好的办法望共享。
2楼
rabbit2002		 对楼主的钻研精神，表示敬佩
3楼
xiangzi728		 找这个找了很久了！
谢谢omnw版主！
4楼
yd0209		 把代码放入后，总提示“没有lib”?是怎么回事？
清空剪贴板代码.rar
5楼
wqfzqgk		 要是在VS2010下VSTO清空剪切板很容易的，基本上都是集成的
6楼
水星钓鱼		 想学习，发觉看不懂。先收藏。呵呵
7楼
glhfgtd		 我使用了最后的完善版代码，当时很好用； 可保存后，再打开时， 会弹出如下错误提示，然后保存在模块里vba代码全都不见了。

是什么问题呀， 帮帮我！

 


 


 

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap