VBA数据对象的奇怪行为。GetText返回剪贴板上当前的内容

我之前发布了一个关于MSForms DataObject（从Microsoft Office Excel 2013 VBA访问）引发的错误的问题。在我写那篇文章的时候，我发现了其他更令人担忧的奇怪行为

也许我对DataObject的看法是错误的，但如果是这样的话，MS Office文档是非常误导的。我的期望是：

如果我创建一个DataObject并使用GetFromClipboard方法，它应该将剪贴板上的任何内容加载到该对象中。在我对对象执行其他操作（如调用Clear、SetText等）之前，存储在对象中的数据不应更改

因此，如果我执行以下操作：

手动将一些文本复制到windows剪贴板上

创建数据对象并调用GetFromClipboard

执行一些更改windows剪贴板的VBA操作（但不访问数据对象）

调用DataObject上的GetText

我希望在步骤4中检索到的文本与我在#2中放置的文本相同

然而，情况并非如此，正如下面的示例代码所示

测试说明：

将此代码复制到office应用程序中的标准代码模块中

复制一些文本（例如，从记事本）

运行方法“TestDataObject”

出现提示时，复制一些不同的文本

当第二次出现提示时，复制其他一些不同的文本

（您可能需要添加对“Microsoft Forms 2.0对象库”的引用，只需将UserForm添加到VBA项目中即可快速完成此操作，因为这样会自动添加引用）

“在运行此操作之前复制一些文本。
公共子TestDataObject（）
Dim oData作为数据对象
Set oData=新数据对象
'这是在调用GetFromClipboard之前，所以
'数据对象当前没有文本。
如果oData.GetFormat（1），则
Debug.Print“1）内容：“&oData.GetText（1）
其他的
“这一行将被打印出来。
调试.打印“1）内容：（无）”
如果结束
oData.GetFromClipboard
'现在DataObject有一些文本，将在下面打印。
如果是oData.GetFormat（1），那么Debug.Print“2）内容：“&oData.GetText（1）
MsgBox“复制一些文本”
'如果您复制了新文本，则它将显示在下面（而不是原始数据）
如果是oData.GetFormat（1），那么Debug.Print“3）内容：“&oData.GetText（1）
MsgBox“复制一些不同的文本”
'如果您复制了其他新文本，则它将显示在下面（而不是原始数据）
如果是oData.GetFormat（1），那么Debug.Print“4）内容：“&oData.GetText（1）
端接头

假设我在运行sub之前复制的文本是“Hello”，我希望它打印出以下内容，而不管我在方法运行时手动复制的内容是什么：

1) Contents: (NONE)
2) Contents: Hello
3) Contents: Hello
4) Contents: Hello

但实际产出是这样的：

1) Contents: (NONE)
2) Contents: Hello
3) Contents: World
4) Contents: Goodbye

（假设我在第一次提示时复制了“世界”，在第二次提示时复制了“再见”。）

请注意，Msgbox不会导致此行为。如果愿意，您可以使用DoEvents循环几秒钟。或使用范围对象或其他Excel对象执行复制/粘贴操作，如下所示：

Public子TestDataObject（）
将oData设置为数据对象：设置oData=新数据对象
ThisWorkbook.ActiveSheet.Range（“A1”）。选择
Selection.Value=“你好”
选择，复制
如果oData.GetFormat（1），则
Debug.Print“1）内容：“&oData.GetText（1）
其他的
调试.打印“1）内容：（无）”
如果结束
oData.GetFromClipboard
如果是oData.GetFormat（1），那么Debug.Print“2）内容：“&oData.GetText（1）
Selection.Value=“世界”
选择，复制
如果是oData.GetFormat（1），那么Debug.Print“3）内容：“&oData.GetText（1）
Selection.Value=“再见”
选择，复制
如果是oData.GetFormat（1），那么Debug.Print“4）内容：“&oData.GetText（1）
端接头

这不是Excel特有的。相同的代码在Word中工作，但您必须将选择/复制代码更改为以下代码（例如）：

”在Word中复制文本的代码
Selection.Text=“World”
选择，复制

所以我的问题是：这种行为是预期的还是一个bug？我使用的是Office 2014 64位。32位Office中也会发生这种情况吗？也许这只是一个64位错误

谢谢

我可以复制（32位Office 2010，Win7）

我不得不猜测

GetFromClipboard

只通过引用剪贴板而不是通过值建立链接。因此，无论何时调用

GetText

，它实际上都直接从剪贴板中提取，而不是从数据对象中保存的复制缓存中提取

---

如果您需要剪贴板内容的稳定副本，而该副本不受后续复制操作的影响，则必须将其存储在（例如）字符串变量中。

：-）

我想知道这里讨论的现象是否可以用稍微不同的方式来解释：

在我看来，数据对象和Windows剪贴板在某种程度上是紧密联系在一起的，但这种联系的方式可能已经没有人知道了，也可能没有人知道，因为这是适当的信息。此外，可能存在一些规则、编码或类似规则，用于控制数据对象和Windows剪贴板如何处理不同剪贴板（Office、Windows、Excel等）的意大利面以及其中复制的数据的不同版本。我怀疑在此期间是否有人能够解开意大利面，让它有任何明确的意义。 怪物的“剪贴簿”部分是一个真正的OLE对象，即数据对象。我们有权访问它。 我们的数据对象可能更像是一个钩住事件的东西，它监视Windows剪贴板。我们可以设置可以使用的东西。我们可以使用数据对象影响剪贴板的行为

我的实验告诉我，有些寄存器是不存在的

Sub Tester()
Dim d As New DataObject, d2 As New DataObject

    d2.SetText "first"
    d2.PutInClipboard

    d.GetFromClipboard
    Debug.Print d.GetText  '--> "first"

    d2.SetText "second"
    d2.PutInClipboard

    Debug.Print d.GetText  '--> "second"

    d2.SetText "third"
    d2.PutInClipboard

    Debug.Print d.GetText  '--> "third"

End Sub

Option Explicit '   https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c
' YOU NEED routine, ClearOffPainBouton() - get here, or just comment out Call s to it : --- https://pastebin.com/5bhqBAVx , http://www.eileenslounge.com/viewtopic.php?f=30&t=31849&start=20#p246838  http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11019&viewfull=1#post11019   --- it will be best to copy entire coding here  to a seperate code module
Sub Copying()
Range("C1").Clear
Dim DtaObj As Object '  Late Binding equivalent'                                                                                    If you declare a variable as Object, you might be late binding it.  http://excelmatters.com/2013/09/23/vba-references-and-early-binding-vs-late-binding/   ... if you can ....  http://www.eileenslounge.com/viewtopic.php?f=30&t=31547&start=40#p246602
 Set DtaObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")                                                             ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
Let Range("A1").Value = "CellA1": Range("A1").Copy                ' This probably fills the Excel Clipboard, the Window Clipboard and the Office Clipboard
' DtaObj.PutInClipboard '                                         ' This will fail, DtaObj clear
' MsgBox Prompt:="DtaObj.GetText(1) is   " & DtaObj.GetText()     ' This will fail, DtaObj clear
 DtaObj.GetFromClipboard                                          '
 Let Application.CutCopyMode = False ' This clears the  Excel Clipboard
 Call ClearOffPainBouton             ' This clears the Office Clipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() '  --- "DtaObj.GetText() is  CellA1"
 DtaObj.SetText Text:="New Text" '
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() '  --- "DtaObj.GetText() is  New Text"
' ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")          ' This would error here
 DtaObj.PutInClipboard
 Let Application.CutCopyMode = False ' This clears the  Excel Clipboard
 Call ClearOffPainBouton             ' This clears the Office Clipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     '  --- "CellA1"  is pasted in cell C1
End Sub

Sub Copying2()
Range("C1").Clear
Dim DtaObj As Object '
 Set DtaObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Let Range("A1").Value = "cellA1": Range("A1").Copy     '      This fills the Excel Clipboard, the Window Clipboard and the Office Clipboard
' DtaObj.PutInClipboard '
' MsgBox Prompt:="DtaObj.GetText(1) is   " & DtaObj.GetText()
 DtaObj.GetFromClipboard
 Let Application.CutCopyMode = False                        ' This clears the  Excel Clipboard
 Call ClearOffPainBouton                                    ' This clears the Office Clipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
 DtaObj.SetText Text:="New Text"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
' ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")    ' This would error here
 DtaObj.PutInClipboard
 Let Application.CutCopyMode = False                        ' This clears the  Excel Clipboard
 Call ClearOffPainBouton                                    ' This clears the Office Clipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")
' New bit below - first 6 lines are not doing much if at all
 Range("C1").Clear
 DtaObj.PutInClipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
 DtaObj.GetFromClipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")
' Below we manually copy
 MsgBox prompt:="Please copy anything from anywhere , before hitting  OK  "
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' has not changed
 Range("C1").Clear
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes what you copied
 DtaObj.GetFromClipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' now shows what you copied
' Attempt to use  SetText  to add to windows Clipboard
 DtaObj.SetText Text:="New Text To Paste"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' reflects the added text,  "New Text To Paste"
 DtaObj.PutInClipboard                                      ' This either does nothing or once again puts what you copied there - as it already is, then Excel may know you already did this so does nothing
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes what you copied
 DtaObj.Clear
' MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()' This would error - the registers are empty
' DtaObj.PutInClipboard ' This would also error - there is nothing in the registers to fill the clipboard with
' ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")    ' pastes what you copied
 DtaObj.SetText Text:="New Text To Paste"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' reflects the added text,  "New Text To Paste"
 DtaObj.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes "New Text To Paste"
 DtaObj.SetText Text:="second Text To Paste"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' reflects the added text,  "New Text To Paste"
 DtaObj.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes "New Text To Paste"
End Sub

Sub Tester()
Dim d As New DataObject, d2 As New DataObject
 d2.SetText "first": d2.PutInClipboard
 d.GetFromClipboard
 Debug.Print d.GetText  '--> "first"

 d2.SetText "second": 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "second"

 d2.SetText "third" 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "third"
End Sub
Sub Testes2() 'COPY SOMETING before running this
Dim d As New DataObject, d2 As New DataObject
 d2.SetText "first": 'd2.PutInClipboard
 d.GetFromClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "second": 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "third" 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"
End Sub
Sub Testies3() 'COPY SOMETING before running this
Dim d As New DataObject, d2 As New DataObject
 d2.SetText "first": 'd2.PutInClipboard
 d.GetFromClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "second": d2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "third": d2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"
End Sub