Can I Get the Source Range Of Excel Clipboard Data?

前端 未结 2 1565
小鲜肉
小鲜肉 2020-12-06 13:09

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

Can you also find the actual Source Range

相关标签:
2条回答
  • 2020-12-06 13:51

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

    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).


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

    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

    0 讨论(0)
  • 2020-12-06 14:07

    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.

    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.

    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

    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
    
    0 讨论(0)
提交回复
热议问题