Question

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

也许我对DataObject的看法是错误的，但如果是这样，那么MS Office文档就会产生误导。我的期望是这些：

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

所以，如果我执行以下操作：

将一些文本手动复制到Windows剪贴板上。
创建DataObject并调用GetFromClipboard
执行一些更改Windows剪贴板的VBA操作（但不访问DataObject）
在DataObject上调用GetText

我期待我在步骤4中检索的文本与我在＃2中放置的文本相同。

但是，情况并非如此，正如下面的示例代码所示。

测试说明：

将此代码复制到办公应用程序中的标准代码模块中。
复制一些文字（例如来自记事本）
运行方法“TestDataObject”
出现提示时，请复制一些不同的文字。
第二次提示时，请复制其他一些不同的文字。

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

'Copy some text before running this.
Public Sub TestDataObject()
    Dim oData As DataObject
    Set oData = New DataObject

    'This is BEFORE GetFromClipboard is called, so 
    ' the DataObject currently has NO text in it.
    If oData.GetFormat(1) Then
        Debug.Print "1) Contents: " & oData.GetText(1)
    Else
        'This line will be printed.
        Debug.Print "1) Contents: (NONE)"
    End If

    oData.GetFromClipboard

    'Now the DataObject has some text, and it will be printed below.
    If oData.GetFormat(1) Then Debug.Print "2) Contents: " & oData.GetText(1)

    MsgBox "Copy some Text"

    'If you copied NEW text, then it will be shown below (instead of the original data)
    If oData.GetFormat(1) Then Debug.Print "3) Contents: " & oData.GetText(1)

    MsgBox "Copy some different Text"

    'If you copied other NEW text, then it will be shown below (instead of the original data)    
    If oData.GetFormat(1) Then Debug.Print "4) Contents: " & oData.GetText(1)

End Sub

假设我在运行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

（假设我第一次提示时复制了“World”，第二次提示时又复制了“Goodbye”。）

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

Public Sub TestDataObject() Dim oData As DataObject: Set oData = New DataObject ThisWorkbook.ActiveSheet.Range("A1").Select Selection.Value = "Hello" Selection.Copy If oData.GetFormat(1) Then Debug.Print "1) Contents: " & oData.GetText(1) Else Debug.Print "1) Contents: (NONE)" End If oData.GetFromClipboard If oData.GetFormat(1) Then Debug.Print "2) Contents: " & oData.GetText(1) Selection.Value = "World" Selection.Copy If oData.GetFormat(1) Then Debug.Print "3) Contents: " & oData.GetText(1) Selection.Value = "Goodbye" Selection.Copy If oData.GetFormat(1) Then Debug.Print "4) Contents: " & oData.GetText(1) End Sub

这不是特定于Excel。相同的代码在Word中工作，除了您必须将选择/复制代码更改为此（例如）：

' Code to copy text in Word Selection.Text = "World" Selection.Copy

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

谢谢！

Answer 1

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

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

我必须猜测GetFromClipboard只是通过引用建立链接到剪贴板，而不是通过值。因此，无论何时调用GetText，它实际上都是直接从剪贴板中提取的，而不是从DataObject中保存的复制缓存中提取的。

如果您需要一个不受后续复制操作影响的剪贴板内容的稳定副本，那么您必须将其存储在（例如）String变量中。

Answer 2

GrußGott ：-）

我想知道这里讨论的现象是否可以略有不同：

在我看来，数据对象和Windows剪贴板在某种程度上紧密地联系在一起，但是以一种方式，也许是，没人再确切地知道了，或者那些不知道的是专有信息。另外，可能存在一些规则，编码或类似规则，它们控制数据对象和Windows剪贴板如何处理不同剪贴板（Office，Windows，Excel等…）的细面条以及其中复制的数据的不同版本。我怀疑与此同时有人能解开该意大利面条以使其有任何明显的意义。 “剪贴板” 的一部分怪物是真正的OLE对象，即Data对象。我们可以访问它。我们的数据对象可能更多是监视Windows剪贴板的挂钩事件。我们可以设置一些可以使用的东西。我们可以通过Data对象影响剪贴板的行为

我的实验向我建议，有些寄存器对我们来说不是直接可访问的，我们可以影响这些寄存器，并且这些寄存器在某种程度上与Window Clipboard中的控件密切相关。我认为我们只是对其某些行为不了解。我认为.GetText()将最后添加到寄存器中的东西返回。

一些示例有助于解释这种奇怪的行为：

子复制（）

此例程最初通过Excel范围副本填充Office，Windows和Excel剪贴板 .PutInClipboard和.GetText()最初会失败，因为寄存器没有被引用。 .GetFromClipboard现在以某种方式向数据对象中的寄存器添加了内容；我认为这是从Windows剪贴板获取数据。我清除了Office和Excel剪贴板，以证明代码中不再使用它们。但是，我注意到在清除这些内容之前，我必须先进行.GetFromClipboard的操作：在这种情况下，请清除Office或Excel剪贴板接缝以使Windows剪贴板为空。我不知道为什么会这样，除了剪贴板中的依赖意粉在最初的某个时候开始发挥作用###我不认为通常可以通过清空Windows剪贴板来清空Windows剪贴板Office或Excel剪贴板 .GetText()现在为我提供了复制单元格中的值。但是我相信这可以告诉我我最后一次添加到数据对象的寄存器中的内容。现在，我使用.SetText，并且我相信我会再次向数据对象中的寄存器添加一些内容。 .GetText()现在给了我添加的文本“ New Text” 我建议在这一点上，在此特定代码中，我仍然具有来自剪贴板的单元格中的值，并且该值位于主寄存器中。我现在不太确定“新文本”在哪里/如何。（在某些情况下，我已经看到此“新文本”将用.PutInClipboard替换Windows剪贴板中的文本。奇怪的是，在此例程中不会发生这种情况。）如果我此时尝试粘贴，它将出错。我认为这是合理的：至此，我认为Windows剪贴板中没有数据。 ###在此特定示例中，通过清空Office或Excel剪贴板的代码行清空了Windows剪贴板：通常不是这种情况### .PutInClipboard代码行现在没有错误。
粘贴几行也不会。
可能没有想到的是，粘贴的值不是“ New Text”，而是实际上来自单元格的原始文本（还要注意，这次我们可以清除Office和Excel剪贴板-无论有无这些行，结果都是相同的-代码行ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")显然是在Windows剪贴板上使用的。）

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

子复制2（） 这会使最后一个Sub更进一步..在此短暂地进行编码

'下面有新内容在接下来的6行中，我有一种感觉.PutInClipboard和.GetFromClipboard并没有做什么，甚至根本没有做。 Excel可能知道我没有更改任何数据，因此它会忽略尝试执行通常将应用于某些新数据的操作的尝试。

'手册副本系统提示您复制任何内容。你应该做这个之后，.GetText()并没有改变，但是现在您粘贴了复制的值。这再次表明代码行ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")显然是在使用Windows剪贴板使用.GetFromClipboard之后，您现在会发现.GetText()返回您复制的值

尝试使用.SetText添加到Windows剪贴板我们设置文本（执行.SetText）并执行.PutInClipboard。但是，正如我们所看到的，在这种情况下，这不会更改剪贴板，而且我们手动复制的最后一件事仍然需要粘贴我尝试.Clear 接下来的两行将出错。这很有意义：我已经清空了寄存器。第三行错误不太明显。建议.Clear清除Windows剪贴板。我不确定情况是否总是如此。最终的代码行通过.SetText成功地向Windows剪贴板添加了一些内容。我的解释是，由于所有寄存器都是空的，因此.SetText给出的值是唯一的东西，它被添加到一个空的东西中，以便在那里存在并且可以放入剪贴板。现在，在这种情况下，第二次尝试通过SetText添加也成功。在这种情况下为什么应该这样有些令人困惑。

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

_.__________________________________________

回到最初的问题..解释奇怪的行为...只是我的看法...

_ ......问：这是预期的行为还是错误？

_ .... A

如果我对上述情况的评估是正确的，我想我希望这样做：进行手动复制或通过编码进行复制会在数据对象的寄存器中创建一个条目。这似乎是.GetText()所得到的–输入的最后一件事，无论是通过副本还是通过.SetText。除非寄存器为空，否则.SetText对.PutInClipboard不会有任何影响。我猜想这样做的原因与如何使用format东西有效地具有多个文本有关。清空这些寄存器所需的内容始终不清楚，也就是说，.Clear是否始终是必需的。显然，剪贴板对我认为的每个人来说都是一个谜。

@蒂姆·威廉姆斯。

子测试器（）

我认为您的Sub Tester()的结果在以下情况下是不变的：如果Windows剪贴板中没有任何内容，则需要d2.PutInClipboard和d.GetFromClipboard的代码行使d.GetText第一次不会出错。就初始化寄存器而言，这与进行d.SetText具有类似的效果，这在某种程度上与d有关。（如果Windows剪贴板中有东西，则不需要d2.PutInClipboard来防止d.GetText出错，但是它将返回Windows剪贴板中的内容。）您永远不需要第二个d2.PutInClipboard和第二个d2.PutInClipboard，因为它们不会对您的编码产生任何影响：只要您拥有第一个.GetText，就可以得到显示的结果。我的理解是，d2.PutInClipboard表示添加了它所知道的最后一件事。但是，您会发现，如果将某些内容复制到Windows剪贴板中并删除所有3条d.GetText行，那么d2将始终告诉您窗口剪贴板中的内容。在某种情况下，它已经失去了对Testies3()正在做什么的意识。要确认这一点，您可以尝试将某些内容复制到Windows剪贴板，然后运行Sub d2.PutInClipboard，其中删除了第一个Sub Testies3()，但包括了第二个和第三个。在这种情况下，您的例程将始终告诉您Windows剪贴板中的内容，至少是从Word…复制时。（…。如果您从Excel内部复制某些内容...。那么，当您第一次运行最后一个例程d时，将会得到一些有趣的结果。有些事情正在设法使d2知道{{ 1}}就是这样做的，这是从Excel复制内容后第一次运行代码。如果从文本datei或浏览器中复制内容，但是如果从Word复制，则同样会发生这种情况。如果您试图完全了解剪贴板中相互依存的意大利面条上发生了什么，那么您会发疯…

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

来自VBA DataObject的奇怪行为。 GetText返回剪贴板上当前的内容

2 个答案: