清除办公剪贴板，使复制的数据不与其他办公程序共享

Posted 2023-05-06

【中文标题】清除办公剪贴板，使复制的数据不与其他办公程序共享

【英文标题】：Clearing office clipboard so that copied data is not shared with other office programs

【发布时间】：2014-01-15 12:39:10

【问题描述】：

我有点坚持实现需要在复制数据时从办公室剪贴板中清除数据的重要功能。

目的不是与其他办公程序共享内容，例如。 word, powerpoint 等的场景是我的 excel 表中有一些重要的内容。一旦我复制了它，它很快就会出现在办公室剪贴板上。如果我一直在 excel 中复制这些东西，它会一直在其他办公程序中收集。但是，Windows 剪贴板将仅包含最近输入的内容，可以使用

System.Windows.Forms.Clipboard.clear():

有没有办法清除办公室剪贴板？

我搜索了一下，发现程序可能没有明确的解决方案，但是应该可以在 FindWindowEx(....) 的帮助下获取办公室剪贴板窗口，然后可以发送消息以清除内容。这种方式我好像搞不定。

谁能告诉他们是否遇到过同样的问题？

【参考方案1】：

这可能会让你朝着正确的方向轻推...取自：mrexcel.com

Option Explicit

Sub myClr()
  'Put this sub inta a Sheet Module, like: Sheet1.
  Call ClearOfficeClipboard
End Sub

'Put the code from here down into a Standard Module, like Module1.
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&, hWindow&, hParent&
    Static sTask As String
    '****Dim hClip As Long************************'changed by Lary
    Dim octl, bScreenUpdatingIsOn As Boolean
    Static lParameter As Long, bNotFirstVisibleTime As Boolean, hClip As Long, bNotFirstTime As Boolean

If Not (bNotFirstTime) Then
    lParameter = MakeLong(120, 18)
    sTask = Application.CommandBars("Task Pane").NameLocal
    'Handle for XLMAIN
    hMain = Application.hwnd
    bNotFirstTime = True
End If

With Application.CommandBars("Task Pane")

    If Not .Visible Then
        'assume have to force the window if it is not visible, since it appears that
        ' the window class does not remain loaded if you clear a non-visible clipboard


            'determine current status of screenupdating so that this sub does not change it
            bScreenUpdatingIsOn = Application.ScreenUpdating
            If bScreenUpdatingIsOn Then Application.ScreenUpdating = False

            Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
            If Not octl Is Nothing Then octl.Execute
            .Visible = False

            'return to screenupdating on if that is what it was in the beginning
            If bScreenUpdatingIsOn Then Application.ScreenUpdating = True

            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
    Else
        If Not (bNotFirstVisibleTime) Then** 'find hClip if window is visible
            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
            bNotFirstVisibleTime = True
        End If
    End If
End With

If hClip = 0 Then
    MsgBox "Cant find Clipboard window"
    Exit Sub
End If
Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
End Sub

【讨论】：

我看到了这个解决方案，但不知道它是否只适用于特定版本的 MS Office。因为它不适用于 Office 2007。:(

【参考方案2】：

以下代码已针对 vb.net 中的 Excel 2013 进行了自定义。只需将一个按钮添加到您的功能区，代码就会像魅力一样发挥作用。

  Private Const WM_LBUTTONDOWN As Long = &H201&
        Private Const WM_LBUTTONUP As Long = &H202&

    WithEvents oAppWD As Excel.Application

    Public oDoc As Excel.Workbook

    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Int32)
    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Int32
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
    Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Int32) As Int32



Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click
        Dim hMain As Int32, hWord As Int32, hClip As Int32, hWindow As Int32, hParent As Int32
        Dim lParameter As Int32
        Dim sTask As String
        Dim HWND As Int32

        'Open the selected File
        oAppWD = Globals.ThisAddIn.Application 'DirectCast(System.Runtime.InteropServices.Marshal.GetActiveObject("Excel.Application"), Excel.Application)
        oAppWD.Visible = True
        oDoc = oAppWD.ActiveWorkbook

        oDoc.Activate()
        oDoc.Windows(1).Activate()


        Sleep(2000)
        ' MessageBox.Show("Doing it.....")

        HWND = FindWindow("XLMAIN", vbNullString)

        ' Make Office Clipboard Visible
        oAppWD.CommandBars("Office Clipboard").Visible = True

        BringWindowToTop(HWND)

        ' Get the handles of the respective Windows Of the Office
        sTask = "Office Clipboard"
        hMain = HWND
        hWord = FindWindowEx(hMain, 0, "EXCEL2", vbNullString)

        hParent = hWord : hWindow = 0
        hWindow = FindWindowEx(hParent, 0, "MsoCommandBar", sTask)
        If hWindow Then
            hParent = hWindow : hWindow = 0
            hWindow = FindWindowEx(hParent, 0, "MsoWorkPane", vbNullString)
            If hWindow Then
                hParent = hWindow : hWindow = 0

                hClip = FindWindowEx(hParent, 0, vbNullString, "Collect and Paste 2.0")

            End If
        End If


        If hClip = 0 Then
            MsgBox("Cant find Clipboard window")
            Exit Sub
        End If
        ' Pass the message 120,18 are the respective co-ordinates of the Clear all button.
        lParameter = MakeLong(120, 18)
        ' Send the Message
        Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
        Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
        Sleep(100)

    End Sub
    Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Int32
        MakeLong = nHiWord * 65536 + nLoWord
    End Function