Can I Get the Source Range Of Excel Clipboard Data? - vba

Question

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 (ie Worksheet, Row & Column) of that Data?
Alternatively, can you find the Last Copied Range, which is indicated with a Dashed Outline Border (NOT the Selected Range)?
Preferably using Excel 2003 VBA

Answer 1

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

Answer 2

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

Answer 3

I completely rewrote the previous answer because I needed to get other kinds of data into Excel besides ranges. The new code is more versatile, and gets different formats off the clipboard as strings. Extracting the Excel range ends up being much simpler, and I'm also using it for bitmaps and text.
The last routine gets the number for non-built-in formats. The middle routine gets the clipboard contents as a string for the specified format. The first routine parses the Excel range from this string with the split function.
'https://officeaccelerators.wordpress.com/2013/11/27/reading-data-with-format-from-clipboard/
'https://social.msdn.microsoft.com/Forums/sqlserver/en-US/ee9e0d28-0f1e-467f-8d1d-1a86b2db2878/a-clipboard-object-for-vba-including-microsoft-word?forum=worddev
#If VBA7 And Win64 Then
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongLong) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
#Else
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cbCopy As Long)
#End If
'test routine displays a message box with the marching ants range
'_2022_10_30
Function fTest_GetClipboardRange()
Dim rngClipboard As Range
Set rngClipboard = fGetClipboardRange
If rngClipboard Is Nothing Then
MsgBox ("No Excel range was found on the clipboard.")
ElseIf Application.CutCopyMode = xlCopy Then 'this is always copy because of sheet add
MsgBox (fGetClipboardRange.Address & " has been copied to the clipboard.")
ElseIf Application.CutCopyMode = xlCut Then
MsgBox (fGetClipboardRange.Address & " has been cut to the clipboard.")
End If
End Function
'reads excel copy-paste range from the clipboard and returns range object or nothing if not found
'_2022_03_19
Function fGetClipboardRange() As Range 'get excel copy or cut range from clipboard
Dim strClipboard As String 'raw clipboard data
Dim arrClipboard() As String 'parse into an array
Set fGetClipboardRange = Nothing 'default is nothing
strClipboard = fGetClipboardData("link") 'get the link data string
If strClipboard = "" Then Exit Function 'done if it's empty
arrClipboard = Split(strClipboard, Chr(0)) 'else parse at null characters
If arrClipboard(0) <> "Excel" Then Exit Function 'excel should be first
strClipboard = "'" & arrClipboard(1) & "'!" & arrClipboard(2) 'parse the range from the others
strClipboard = Application.ConvertFormula(strClipboard, xlR1C1, xlA1) 'convert to a1 style
Set fGetClipboardRange = Range(strClipboard) 'range needs a1 style
End Function
'read clipboard for specified format into string or null string
'_2022_03_19
Function fGetClipboardData(strFormatId As String) As String 'read clipboard into string
#If VBA7 And Win64 Then
Dim hMem As LongPtr 'memory handle
Dim lngPointer As LongPtr 'memory pointer
#Else
Dim hMem As Long 'memory handle
Dim lngPointer As Long 'memory pointer
#End If
Dim arrData() As Byte 'clipboard reads into this array
Dim lngSize As Long 'size on clipboard
Dim lngFormatId As Long 'id number, for format name
fGetClipboardData = "" 'default
lngFormatId = fGetClipboardFormat(strFormatId) 'get format
If lngFormatId <= 0 Then Exit Function 'zero if format not found
CloseClipboard 'in case clipboard is open
If CBool(OpenClipboard(0)) Then 'open clipboard
hMem = GetClipboardData(lngFormatId) 'get memory handle
If hMem > 0 Then 'if there's a handle
lngSize = CLng(GlobalSize(hMem)) 'get memory size
If lngSize > 0 Then 'if we know the size
lngPointer = GlobalLock(hMem) 'get memory pointer
If lngPointer > 0 Then 'make sure we have the pointer
ReDim arrData(0 To lngSize - 1) 'size array
CopyMemory arrData(0), ByVal lngPointer, lngSize 'data from pointer to array
fGetClipboardData = StrConv(arrData, vbUnicode) 'convert array to string
End If
GlobalUnlock hMem 'unlock memory
End If
End If
End If
CloseClipboard 'don't leave the clipboard open
End Function
'return format number form format number, format number from format name or 0 for not found
'_2022_03_19
Function fGetClipboardFormat(strFormatId As String) As Long 'verify, or get format number from format name
Dim lngFormatId As Long 'format id number
fGetClipboardFormat = 0 'default false
If IsNumeric(strFormatId) Then 'for format number
lngFormatId = CLng(strFormatId) 'use number for built in format
CloseClipboard 'in case clipboard is already open
If CBool(OpenClipboard(0)) = False Then 'done if can't open clipboard
ElseIf CBool(IsClipboardFormatAvailable(lngFormatId)) = True Then 'true if format number found
fGetClipboardFormat = lngFormatId 'return format number
End If
CloseClipboard 'don't leave the clipboard open
Else
lngFormatId = RegisterClipboardFormat(strFormatId & Chr(0)) 'else get number from format name
If (lngFormatId > &HC000&) Then fGetClipboardFormat = lngFormatId 'if valid return format number
End If
End Function