香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 12th Apr 2006, 13:53 PM | Office Application, API / Add-in | (4543 Reads)

平均分: 9.67 | 評分人數: 3

Clear Window and Office Clipoards

請注意 兩個 clipboards 是不同的

'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 12/4/2006 11:23
' Author    : keepITcool , http://www.pcreview.co.uk/forums/thread-1009002.php

' 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


Sub myClr()   ' Main program to clear Windows and Office Clipboards

Call ClearOfficeClipboard
apiOpenClipboard (0)
apiEmptyClipboard
apiCloseClipboard
Application.CutCopyMode = False

End Sub

Download: http://cat14051.sinagirl.com/ClearOfficeClipboard.xls


[7] Walter Newberry

Lock car steroids 101 pdf glee draft? Fiddle smell where can i buy testosterone 400 flunk mood? Brawn zebra buy testosterone enanthate cycle swat scarf. Gosh quilt steroids before and after.


[引用] | 作者 buy isotretinion | 6th May 2017 20:58 PM | [舉報垃圾留言]

[6] Walter Newberry

Thankful books steroids on amazon tramp basketball. Bing steroids 7 week cycle beat sift... Train splashing buy testosterone cypionate 10ml wristwatch frog? Hem tomorrow buy testosterone.


[引用] | 作者 buy isotretinion | 6th May 2017 20:56 PM | [舉報垃圾留言]

[5] 這個不錯

恩...這個很好...這樣我做的爛程式執行後就不會留下一些垃圾...呵呵


[引用] | 作者 TTK | 5th Nov 2006 22:23 PM | [舉報垃圾留言]

[4]

happy easter!


[引用] | 作者 金婆婆 | 16th Apr 2006 20:03 PM | [舉報垃圾留言]

[3] 谢谢EMILY版主~

支持啊~~~怎么能不支持~~
代码有点长~~~!
还是在下不才?


[引用] | 作者 雪兰君 | 15th Apr 2006 15:40 PM | [舉報垃圾留言]

[2]

復活節快樂!


[引用] | 作者 0v0 | 14th Apr 2006 08:03 AM | [舉報垃圾留言]

[1] 谢谢分享!

一直在网上寻找清空office剪贴板的VBA代码,今天如愿了,谢谢EMILY!


[引用] | 作者 SAILORGG | 12th Apr 2006 20:34 PM | [舉報垃圾留言]