现在的位置: 首页 > Excel 杂记 > 正文

关于清空 Office 的剪切板

2014年07月02日 Excel 杂记 ⁄ 共 9074字 ⁄ 字号 暂无评论 ⁄ 阅读 7,365 次
这是我原来写在百度的一篇博文,现在略作修改转到这边来
 

关于清空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 : 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()
    ' 以下部分定义变量
    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种方法的局限性。

给我留言

您必须 [ 登录 ] 才能发表留言!