Winforms Excel VBA数据对象：未实现PutInClipboard

我维护一个Excel工作簿，其中包含一堆VBA宏。该手册在过去几个月一直在使用，基本上没有发生任何事件。我们有一个VBA函数，用于调用其他VBA函数。其目的是备份剪贴板数据，运行该功能，然后恢复剪贴板数据。这很简单

Sub FunctionHandler()
    Dim clipboardData As New DataObject
    clipboardData.GetFromClipboard
    
    '' There are a dozen or so macros that can be called here
    Call AnyFunction() 
    
    On Error Resume Next
    clipboardData.PutInClipboard
    On Error GoTo 0
End Sub

VBA项目包括对Microsoft Forms 2.0对象库（FM20.DLL）的引用，这是使用DataObject类所必需的

在除我之外的所有人的电脑上，该功能正常工作。它备份剪贴板数据，运行函数，并恢复剪贴板内容

这个问题只发生在我的计算机上。每当我运行此函数时，如果剪贴板是空的，或者将纯文本复制到剪贴板（可以从excel或记事本之类的外部源复制），就会抛出一个错误。错误的文本是

运行时错误“-2147467263（80004001）”：

DataObject:未实现PutInClipboard

错误被抛出到行

clipboardData.PutInClipboard

上。对

clipboardData.GetFromClipboard

的调用永远不会抛出它。对我来说，这意味着对Microsoft Forms 2.0对象库的引用没有任何问题

如果在运行此宏之前将单元格或区域复制到剪贴板，也不会引发此错误。仅当剪贴板为空或包含纯文本数据时

在我工作的时候，这个错误从来没有在别人的电脑上出现过。我已确保FM20.DLL存在于我计算机上的正确文件夹中。我已重新启动Excel和计算机，但问题仍然存在

当我把代码缩减到这一步时，我也会遇到同样的错误

Sub FunctionHandler()
    Dim clipboardData As New DataObject
    clipboardData.GetFromClipboard

    clipboardData.PutInClipboard
End Sub

我还有工作簿的多个完整备份副本，每个具有此功能的备份都会给我带来相同的问题（但同样，只有我）

有人知道我怎么解决这个问题吗

---

编辑：在我的计算机上使用新的Windows配置文件时不会发生此问题。

我不久前遇到过类似的问题，这些是我遇到的最好的解决方案，可以满足您的需要（a）可以保存一些格式和其他有用的内容，b）只有字符串） 我可以在这里看到两种场景（及其解决方案/变通方法）：
a）您只需保存数据（但在例行程序中，您不会在任何时候清除剪贴板）。
在独立模块中，执行以下操作：

Option Explicit
Private Declare Function OpenClipboard Lib "User32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Sub SaveClipBoardContents()
    OpenClipboard 0
    CloseClipboard
End Sub
Sub ClearClipBoardContents()
    Application.CutCopyMode = False
End Sub

相应地更换您的sub

Sub FunctionHandler()
    Call SaveClipBoardContents

    '' There are a dozen or so macros that can be called here
    Call AnyFunction() 
    'clipboard will reamain because of the sub SaveClipBoardContents
End Sub

b）您正在清除数据（或使用其中的剪贴板），并希望保留原始数据（如果有）。 这是对Microsoft帮助中用于处理错误的代码稍作修改。同样的逻辑，将其独立粘贴到模块中

Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
   As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _
   Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _
   dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
   ByVal lpString2 As Any) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_GetData()
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long
   If OpenClipboard(0&) = 0 Then: MsgBox "Cannot open Clipboard. Another app. may have it open": Exit Function
   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then GoTo OutOfHere

   ' Lock Clipboard memory so we can reference
   ' the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)

   If Not IsNull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
      ' Peel off the null terminating character.
      On Error GoTo OutOfHere
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
   Else
      MsgBox "Could not lock memory to copy string from."
   End If
OutOfHere:
   RetVal = CloseClipboard()
   ClipBoard_GetData = IIf(MyString = "OutOfHere", "", MyString)
End Function

你的潜水艇也要换

Sub FunctionHandler()
    Dim DataClipBoard As String
    Dim clipboardData As DataObject
    DataClipBoard = ClipBoard_GetData
    '...
    Application.CutCopyMode = False ' to simulate if clipboard is lost at some point
    '...
    Set clipboardData = New DataObject
    With clipboardData
        .SetText DataClipBoard
        .PutInClipboard
    End With
End Sub

注意：引用“FM20.dll”与我用于此测试的引用相同。 更多信息请访问
编辑：
使用b）方法复制页边距、颜色的变通方法

---

如果这不符合您的需要，请提供更多信息。

我无法回答您出现问题的原因，但如果只是无法将其放入剪贴板，您可以尝试仅将该部分替换为以下内容。它只处理字符串，因此可能不会为您执行此操作

Sub PutDataInClipBoard(intext As String)
    Dim objShell As Object
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run "cmd /C echo|set/p=" & intext & "| CLIP", 2
End Sub

---

为了解决您面临的奇怪的依赖性问题，您是否可以尝试将早期绑定代码替换为后期绑定等效代码

用法示例-请注意引用

MSForms 2.0对象库的幻数：

Option Explicit

Sub Test()

    ' set clipboard and test by pasting to range
    SetClipboard "hello world"
    Sheet1.Range("A1").PasteSpecial Paste:=xlPasteAll

End Sub

Sub SetClipboard(strToSet As String)

    Dim objDataObject As Object

    ' get clipboard with late binding
    Set objDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    ' set input string to clipboard
    With objDataObject
        .SetText strToSet
        .PutInClipboard
    End With

    ' clean up    
    Set objDataObject = Nothing

End Sub

在你的同事和计算机池中，你是否能够“热桌”（登录到远程存储你的个人资料的任何机器）；或者每个人的个人资料只存储在每台机器的硬盘上？如果是这样，请尝试另一台机器。这听起来像是一个配置文件/安装问题。我以前也遇到过类似的问题：不是这个剪贴板问题，而是一个库DLL只给一个用户造成了问题，尽管她的Excel安装应该和每个人的一样。我会尝试一下。我认为这是一个excel问题或winforms dll的问题。这是一个有趣的想法，但这段代码仍然存在同样的问题。第一个解决方案不会有帮助，因为剪贴板在被调用的函数中被大量使用。第二种解决方案基本上是可行的。它可以很好地复制纯文本，并且在清除剪贴板时不会中断。它不复制任何范围特性（颜色、边框）或公式。然而，无论出于什么原因，对PutInClipboard的调用都在这里起作用。谢谢你的建议。我不认为有办法保存这种属性（我没有发现），剪贴板作为变量。不要处理它，因为它是变量，如果我们检查活动工作表中调用代码的用户是否复制到剪贴板的活动范围，怎么样？最后，由于存储了该范围，因此可以再次调用副本。检查我的最新答案。PS PutInClipboard可以工作，因为您需要将变量设置为新的数据对象，这有点难以理解为什么要这样做，但是，这与您添加的已编辑解决方案有关。我认为我需要的更多的是一种获得正确的工作解决方案的方法（仅使用windows窗体库中定义的DataObject类），而不是一种变通方法。如果该范围在另一个工作簿中，您应该参考它，如果不是，很遗憾，我再也帮不上忙了，我认为您无法将这些元素保存在VBA中。与流行的观点相反，
Application.CutCopyMode=False
不清除剪贴板内容。。。试试看！这类作品。它不能处理excel中的格式化数据。
Option Explicit

Sub Test()

    ' set clipboard and test by pasting to range
    SetClipboard "hello world"
    Sheet1.Range("A1").PasteSpecial Paste:=xlPasteAll

End Sub

Sub SetClipboard(strToSet As String)

    Dim objDataObject As Object

    ' get clipboard with late binding
    Set objDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    ' set input string to clipboard
    With objDataObject
        .SetText strToSet
        .PutInClipboard
    End With

    ' clean up    
    Set objDataObject = Nothing

End Sub