vba 我可以获取Excel剪贴板数据的源范围吗？

Can I Get the Source Range Of Excel Clipboard Data?

提问by mikebinz

If the Clipboard contains an Excel Worksheet Range, you can access that Range's Data with the DataObject Object

如果剪贴板包含 Excel 工作表范围，则可以使用 DataObject 对象访问该范围的数据

Can you also find the actual Source Range(ie Worksheet, Row & Column) of that Data?

您还可以找到该数据的实际来源范围（即工作表、行和列）吗？

Alternatively, can you find the Last CopiedRange, which is indicated with a Dashed Outline Border (NOTthe Selected Range)?

或者，您能否找到用虚线轮廓边框（不是选定范围）表示的上次复制范围？

Preferably using Excel 2003 VBA

最好使用 Excel 2003 VBA

回答by enderland

Not directly, no - the clipboard object seems to only contain the values of the cells (though Excel obviously somehow remembers the border):

不是直接的，不是 - 剪贴板对象似乎只包含单元格的值（尽管 Excel 显然以某种方式记住了边框）：

Sub testClipborard()

    Dim test As String
    Dim clipboard As MSForms.DataObject
    Set clipboard = New MSForms.DataObject

    clipboard.GetFromClipboard
    test = clipboard.GetText

    MsgBox (test)

End Sub

Note you will need a reference to the Microsoft Forms 2.0 Library to get this to run (and if you don't have values in the cells it will also fail).

请注意，您需要引用 Microsoft Forms 2.0 库才能运行它（如果单元格中没有值，它也会失败）。

---

---

That being said, you can try something like the following - add this to a module in the VBA editor.

话虽如此，您可以尝试以下操作 - 将其添加到 VBA 编辑器中的模块中。

Public NewRange As String 
Public OldRange As String 
Public SaveRange As String 
Public ChangeRange As Boolean 

And use the following in a sheet object

并在工作表对象中使用以下内容

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 

     'save previous selection
    OldRange = NewRange 

     'get current selection
    NewRange = Selection.Address 

     'check if copy mode has been turned off
    If Application.CutCopyMode = False Then 
        ChangeRange = False 
    End If 

     'if copy mode has been turned on, save Old Range
    If Application.CutCopyMode = 1 And ChangeRange = False Then 
         'boolean to hold "SaveRange" address til next copy/paste operation
        ChangeRange = True 
         'Save last clipboard contents range address
        SaveRange = OldRange 
    End If 

End Sub 

It seemingly works, but, it's also probably fairly prone to different bugs as it is attempting to get around the issues with the clipboard. http://www.ozgrid.com/forum/showthread.php?t=66773

它似乎有效，但是，当它试图解决剪贴板的问题时，它也可能相当容易出现不同的错误。 http://www.ozgrid.com/forum/showthread.php?t=66773

回答by Oddclock

This code is being used in Excel 2019 64 bit to get the range of the cells on the clipboard as opposed to the contents of the cells.

此代码在 Excel 2019 64 位中用于获取剪贴板上单元格的范围，而不是单元格的内容。

fGetClipRange returns a range object for the Excel range that is cut or copied onto the clipboard, including book and sheet. It reads it directly from the clipboard using the "Link" format, and requires the ID number for this format. The ID associated with the registered formats can change, so fGetFormatId finds the current format ID from a format name. Use Application.CutCopyMode to determine whether the cells were cut or copied.

fGetClipRange 返回被剪切或复制到剪贴板上的 Excel 范围的范围对象，包括书籍和工作表。它使用“链接”格式直接从剪贴板读取它，并需要此格式的 ID 号。与注册格式关联的 ID 可以更改，因此 fGetFormatId 从格式名称中查找当前格式 ID。使用 Application.CutCopyMode 确定是剪切还是复制单元格。

This site was useful for working with the clipboard in VBA: https://social.msdn.microsoft.com/Forums/office/en-US/ee9e0d28-0f1e-467f-8d1d-1a86b2db2878/a-clipboard-object-for-vba-including-microsoft-word?forum=worddev

该站点对于在 VBA 中使用剪贴板很有用：https: //social.msdn.microsoft.com/Forums/office/en-US/ee9e0d28-0f1e-467f-8d1d-1a86b2db2878/a-clipboard-object-for- vba-包括-microsoft-word?forum=worddev

Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal lngFormat As Long) As LongPtr
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardFormatNameA Lib "user32" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

'2020-02-11 get excel copy or cut range from clipboard
Function fGetClipRange() As Range
Dim strGetClipRange As String    'return range
Dim lptClipData As LongPtr  'pointer to clipboard data
Dim strClipData As String   'clipboard data
Dim intOffset As Integer    'for parsing clipboard data
Dim lngRangeLink As Long  'clipboard format
Const intMaxSize As Integer = 256   'limit for r1c1 to a1 conversion
    lngRangeLink = fGetFormatId("Link") 'we need the id number for link format
    If OpenClipboard(0&) = 0 Then GoTo conDone  'could not open clipboard
    lptClipData = GetClipboardData(lngRangeLink)    'pointer to clipboard data
    If IsNull(lptClipData) Then GoTo conDone    'could not allocate memory
    lptClipData = GlobalLock(lptClipData)   'lock clipboard memory so we can reference
    If IsNull(lptClipData) Then GoTo conDone    'could not lock clipboard memory
    intOffset = 0   'start parsing data
    strClipData = Space$(intMaxSize)    'initialize string
    Call lstrcpy(strClipData, lptClipData + intOffset)  'copy pointer to string
    If strClipData = Space$(intMaxSize) Then GoTo conDone   'not excel range on clipboard
    strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1)    'trim null character
    If strClipData <> "Excel" Then GoTo conDone     'not excel range on clipboard
    intOffset = intOffset + 1 + Len(strClipData)    'can't retrieve string past null character
    strClipData = Space$(intMaxSize)    'reset string
    Call lstrcpy(strClipData, lptClipData + intOffset)  'book and sheet next
    strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1)
    strGetClipRange = "'" & strClipData & "'!"  'get book and sheet
    intOffset = intOffset + 1 + Len(strClipData)    'next offset
    strClipData = Space$(intMaxSize)    'initialize string
    Call lstrcpy(strClipData, lptClipData + intOffset)  'range next
    strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1)
    strGetClipRange = strGetClipRange & strClipData 'add range
    strGetClipRange = Application.ConvertFormula(strGetClipRange, xlR1C1, xlA1)
    Set fGetClipRange = Range(strGetClipRange)  'range needs a1 style
conDone:
    Call GlobalUnlock(lptClipData)
    Call CloseClipboard
End Function

'2020-02-11 clipboard format id number changes so get it from format name
Function fGetFormatId(strFormatName As String) As Long
Dim lngFormatId As Long
Dim strFormatRet As String
Dim intLength As Integer
    If OpenClipboard(0&) = 0 Then Exit Function   'could not open clipboard
    intLength = Len(strFormatName) + 3  'we only need a couple extra to make sure there isn't more
    lngFormatId = 0 'start at zero
    Do
        strFormatRet = Space(intLength) 'initialize string
        GetClipboardFormatNameA lngFormatId, strFormatRet, intLength    'get the name for the id
        strFormatRet = Trim(strFormatRet)   'trim spaces
        If strFormatRet <> "" Then  'if something is left
            strFormatRet = Left(strFormatRet, Len(strFormatRet) - 1)    'get rid of terminal character
            If strFormatRet = strFormatName Then    'if it matches our name
                fGetFormatId = lngFormatId  'this is the id number
                Exit Do 'done
            End If
        End If
        lngFormatId = EnumClipboardFormats(lngFormatId) 'get the next used id number
    Loop Until lngFormatId = 0  'back at zero after last id number
    Call CloseClipboard 'close clipboard
End Function