清空Excel剪贴板

'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime : 12/4/2006 11:23
' Author    : keepITcool , http://www.mrexcel.com/board2/viewtopic.php?t=143291        
' Author    : Joe Was , http://www.mrexcel.com/board2/viewtopic.php?t=173413            
' 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