我可以获取Excel剪贴板数据的源范围吗? [英] Can I Get the Source Range Of Excel Clipboard Data?
问题描述
如果剪贴板包含Excel工作表范围,则可以使用DataObject对象访问该范围的数据
If the Clipboard contains an Excel Worksheet Range, you can access that Range's Data with the DataObject Object
您还可以找到实际的源范围
或者该数据的 strong(即工作表,行和列)?或者,您是否可以找到最后复制范围?轮廓线是虚线(不是选定范围)?
Alternatively, can you find the Last Copied Range, which is indicated with a Dashed Outline Border (NOT the Selected Range)?
最好使用Excel 2003 VBA
Preferably using Excel 2003 VBA
推荐答案
在Excel 2019 64位中使用此代码来获取剪贴板上单元格的范围,而不是单元格的内容。
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返回剪切或复制到剪贴板(包括书和图纸)的Excel范围的范围对象。它使用链接格式直接从剪贴板读取它,并需要此格式的ID号。与注册格式关联的ID可以更改,因此fGetFormatId从格式名称中查找当前格式ID。使用Application.CutCopyMode确定是否剪切或复制了单元格。
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.
此站点对于在VBA中使用剪贴板很有用: https://social.msdn.microsoft.com/Forums/office/zh-CN/ee9e0d28-0f1e-467f-8d1d-1a86b2db2878/a-clipboard-object-for-vba-includes-microsoft-word?forum = worddev
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
这篇关于我可以获取Excel剪贴板数据的源范围吗?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!