如何返回处于复制或剪切状态的单元格区域的地址？

dianbotang

Selection.Address返回选中单元格区域的地址，请问如何返回处于复制或剪切状态的单元格区域的地址？用什么属性来实现？

taller

没有属性可以返回这个地址

wxhnr

用笨办法：新建一个工作表选择性粘贴----粘贴链接---读取单元格里的地址----删除工作表

小fisher

可以用API直接从内存中读取：

1. Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
   
2. Private Declare Function CloseClipboard Lib "user32" () As Long
   
3. Private Declare Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
   
4. Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
   
5. 
   
6. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
   
7. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
   
8. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
9. Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
   
10. 
    
11. Private Function GetCutCopyRange() As Range
    
12.     Dim sBuffer As String
    
13.     Dim sItem As Variant
    
14.     Dim hMem As Long
    
15.     Dim nSize As Long
    
16.     Dim lpData As Long
    
17.     Dim lFormat As Long
    
18. 
    
19.     Dim sWorkbook As String
    
20.     Dim sSheet As String
    
21.     Dim sRange As String
    
22.    
    
23.     OpenClipboard 0&
    
24.     lFormat = RegisterClipboardFormat("Link")
    
25.     If lFormat <> 0 Then
    
26.         hMem = GetClipboardData(lFormat)
    
27.         If hMem <> 0 Then
    
28.             lpData = GlobalLock(hMem)
    
29.             If lpData <> 0 Then
    
30.                 nSize = GlobalSize(hMem)
    
31.                 sBuffer = Space(nSize)
    
32.                 CopyMemory ByVal StrPtr(sBuffer), ByVal lpData, ByVal nSize
    
33.                 sBuffer = StrConv(sBuffer, vbUnicode)
    
34.             End If
    
35.             GlobalUnlock hMem
    
36.         Else
    
37.             CloseClipboard
    
38.             Exit Function
    
39.         End If
    
40.     End If
    
41.     CloseClipboard
    
42.     sItem = Split(sBuffer, Chr(0))
    
43.     sItem(1) = Mid(sItem(1), InStr(sItem(1), "[") + 1)
    
44.     sWorkbook = Left(sItem(1), InStr(sItem(1), "]") - 1)
    
45.     sSheet = Mid(sItem(1), InStr(sItem(1), "]") + 1)
    
46.     sRange = sItem(2)
    
47.     Set GetCutCopyRange = Workbooks(sWorkbook).Sheets(sSheet).Range(Application.ConvertFormula(sRange, xlR1C1, xlA1))
    
48. End Function

复制代码

测试代码如下（先选中一个单元格区域复制或剪切后再从VB编辑器中运行test宏 - 从工具-宏中运行宏会取消工作表的复制/剪切状态）：

1. Sub test()
   
2.     Dim r As Range
   
3.     Dim s As String
   
4.     Set r = GetCutCopyRange
   
5.     If r Is Nothing Then
   
6.         s = "目前剪贴板中没有Excel单元格区域"
   
7.     Else
   
8.         s = "工作簿：" & vbTab & r.Worksheet.Parent.FullName & vbCrLf
   
9.         s = s & "工作表：" & vbTab & r.Worksheet.Name & vbCrLf
   
10.         s = s & "单元格区域：" & vbTab & r.Address
    
11.     End If
    
12.     MsgBox s
    
13. End Sub
    

复制代码

[ 本帖最后由 小fisher 于 2010-9-28 08:57 编辑 ]

dianbotang

我对API不甚了解，楼上果然高手，在此拜谢了！

kevingarnett198

高手出招果然高！

cbtaja

高级！Mark!