Question

我正在尝试使用MsForms DataObject在使用Range对象的复制/粘贴方法的VBA代码操作期间保留Windows剪贴板的内容。不幸的是，每当我复制纯文本时（例如从记事本或VB IDE等），都会出现错误。调用DataObject.PutInClipboard时发生错误。请注意，复制excel单元格或范围时不会发生此错误。我已经制作了一些示例代码来演示错误。

要使用该代码，请将其粘贴到标准VBA代码模块中。然后复制一些文本（例如从立即窗口等）。然后运行宏TestClipboard。你应该在指定的行上得到错误。

您将注意到例程ShowClipboardFormats表示复制纯文本时，剪贴板包含格式0（文本）和44（未知）。复制单元格时，剪贴板包含这些（0和44）以及其他几种格式。因此，DataObject不会遇到无法处理的格式，因为纯文本格式是单元格格式的子集。

我目前在Windows 8.1上使用Office 2013 64位。我想这可能是64位问题，我将在有机会时在32位机器上测试代码。我在其他地方看到过这个问题的报道，但还没有解决方案。在大多数情况下，人们误解了这个问题。（例如，他们认为cliboard是空的或包含无效数据等。事实并非如此）。

Public Sub TestClipboard()
    Dim oData As DataObject
    Set oData = New DataObject
    ShowClipboardFormats
    oData.GetFromClipboard
    oData.PutInClipboard 'Error occurs here, but only when plain text is selected
End Sub

Public Sub ShowClipboardFormats()
    Dim I&, nFmt&
    Debug.Print "Formats on Clipboard: "
    For I = 1 To UBound(Application.ClipboardFormats)
        nFmt = Application.ClipboardFormats(I)
        Debug.Print nFmt, GetNameOfFormat(nFmt)
    Next I
End Sub

Public Function GetNameOfFormat$(nFormat As XlClipboardFormat)
    Dim S$
    Select Case nFormat
        Case xlClipboardFormatBIFF: S = "BIFF" '8 = Binary Interchange file format for Excel version 2.x
        Case xlClipboardFormatBIFF12:   S = "BIFF12" '63 = Binary Interchange file format 12
        Case xlClipboardFormatBIFF2:    S = "BIFF2" '18 = Binary Interchange file format 2
        Case xlClipboardFormatBIFF3:    S = "BIFF3" '20 = Binary Interchange file format 3
        Case xlClipboardFormatBIFF4:    S = "BIFF4" '30 = Binary Interchange file format 4
        Case xlClipboardFormatBinary:   S = "Binary" '15 = Binary format
        Case xlClipboardFormatBitmap:   S = "Bitmap" '9 = Bitmap format
        Case xlClipboardFormatCGM:  S = "CGM" '13 = CGM format
        Case xlClipboardFormatCSV:  S = "CSV" '5 = CSV format
        Case xlClipboardFormatDIF:  S = "DIF" '4 = DIF format
        Case xlClipboardFormatDspText:  S = "DspText" '12 = Dsp Text format
        Case xlClipboardFormatEmbeddedObject:   S = "EmbeddedObject" '21 = Embedded Object
        Case xlClipboardFormatEmbedSource:  S = "EmbedSource" '22 = Embedded Source
        Case xlClipboardFormatLink: S = "Link" '11 = Link
        Case xlClipboardFormatLinkSource:   S = "LinkSource" '23 = Link to the source file
        Case xlClipboardFormatLinkSourceDesc:   S = "LinkSourceDesc" '32 = Link to the source description
        Case xlClipboardFormatMovie:    S = "Movie" '24 = Movie
        Case xlClipboardFormatNative:   S = "Native" '14 = Native
        Case xlClipboardFormatObjectDesc:   S = "ObjectDesc" '31 = Object description
        Case xlClipboardFormatObjectLink:   S = "ObjectLink" '19 = Object link
        Case xlClipboardFormatOwnerLink:    S = "OwnerLink" '17 = Link to the owner
        Case xlClipboardFormatPICT: S = "PICT" '2 = Picture
        Case xlClipboardFormatPrintPICT:    S = "PrintPICT" '3 = Print picture
        Case xlClipboardFormatRTF:  S = "RTF" '7 = RTF format
        Case xlClipboardFormatScreenPICT:   S = "ScreenPICT" '29 = Screen Picture
        Case xlClipboardFormatStandardFont: S = "StandardFont" '28 = Standard Font
        Case xlClipboardFormatStandardScale:    S = "StandardScale" '27 = Standard Scale
        Case xlClipboardFormatSYLK: S = "SYLK" '6 = SYLK
        Case xlClipboardFormatTable:    S = "Table" '16 = Table
        Case xlClipboardFormatText: S = "Text" '0 = Text
        Case xlClipboardFormatToolFace: S = "ToolFace" '25 = Tool Face
        Case xlClipboardFormatToolFacePICT: S = "ToolFacePICT" '26 = Tool Face Picture
        Case xlClipboardFormatVALU: S = "VALU" '1 = Value
        Case xlClipboardFormatWK1:  S = "WK1" '10 = Workbook
        Case Else: S = "Unknown"
    End Select
    GetNameOfFormat = S
End Function

当然，使用on error resume next等可以忽略错误本身，但问题是我希望能够恢复剪贴板的内容。我想最好的解决办法就是这样：

Public Sub StoreClipboard()
    'm_StoredData is defined at module level:
    '  Private m_StoredData As MSForms.DataObject

    Set m_StoredData = New DataObject
    With m_StoredData
        .GetFromClipboard
        If .GetFormat(1) Then Debug.Print "Stored Clipboard Text: " & m_StoredData.GetText(1)
    End With
End Sub

Public Sub RestoreClipboard()
    If m_StoredData Is Nothing Then Exit Sub
    Dim sText$
    With m_StoredData
        If .GetFormat(1) Then
            sText = .GetText(1)
            Debug.Print "Stored Text: " & sText
        End If
        On Error Resume Next
        .PutInClipboard
        Debug.Print "Has Text After: " & .GetFormat(1)
        If Err.Number <> 0 Then
            Debug.Print "Had Error"
            If sText <> "" Then
                .SetText sText, 1
                .PutInClipboard
                Debug.Print "Restored Text: " & sText
            End If
        End If
        Set m_StoredData = Nothing
    End With
End Sub

但是当我测试那段代码时，其他一些奇怪的东西似乎正在发生。首先，请注意.PutInClipboard导致错误时也会导致存储的文本丢失。（即打印出“After Text After：False”）其次，甚至更为关注，如果我在调用StoreClipboard和RestoreClipboard之间更改剪贴板内容，（例如我复制“Pizza”，然后调用StoreClipboard，然后复制“Orange”）然后RestoreClipboard打印“存储文本：橙色”（即新的新内容）。但那怎么可能呢？ DataObject应该只存储“Pizza”。对GetText的调用似乎是从剪贴板更新，而不是从存储在数据对象中的内容更新。奇怪。任何人都可以确认这些发现和/或解释它们吗？

谢谢！

DataObject.PutInClipboard引发错误＆＃34;未实现＆＃34;

0 个答案: