Option Explicit
'/锁定内存中指定的内存块,并返回一个地址值,令其指向内存块的起始处
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 Function OpenClipboard _
    Lib "user32" ( _
        ByVal hwnd As Long) _
As Long
'/关闭剪切板
Private Declare Function CloseClipboard _
    Lib "user32" () _
As Long
'/获取剪切板数据
Private Declare Function GetClipboardData _
    Lib "user32" ( _
        ByVal wFormat As Long) _
As Long
'/将一块内存的数据从一个位置复制到另一个位置
Private Declare Sub CopyMemory _
    Lib "kernel32" _
    Alias "RtlMoveMemory" ( _
        Destination As Any, _
        Source As Any, _
        ByVal Length As Long)
'//--------------------------------------------------------------------------------------//
'//-----用于取得处于复制或者剪切状态的单元格区域的函数-----------------//
'//--------------------------------------------------------------------------------------//
Public Function CutCopyRange() As Range
    On Error GoTo Hanlder
    Dim bytData() As Byte, hMem As Long, nClipsize As Long, lpData As Long
    Dim sSource As String, sTemp() As String
    Dim sWorkbook As String, sSheet As String, sRange As String
    '/打开剪切板
    OpenClipboard 0&
    '/取得剪切板中有关Excel单元格复制的信息数据
    hMem = GetClipboardData(49154)
    '/假如存在数据
    If CBool(hMem) Then
        '/取得数据内存的大小
        nClipsize = GlobalSize(hMem)
        '/锁定此内存块，并返回内存块的起始地址
        lpData = GlobalLock(hMem)
        If lpData <> 0 Then
            '/从新定义数组大小
            ReDim bytData(0 To nClipsize - 1) As Byte
            '/将内存复制到数组中
            CopyMemory bytData(0), ByVal lpData, nClipsize
            '/将二进制数组转换成字符串
            sSource = StrConv(bytData, vbUnicode)
            '/拆分字符串
            sTemp = Split(sSource, Chr(0))
            '/假使在拆分得到的字符串2中找到"\"（即工作薄已经保存）
            If InStr(sTemp(1), "\") Then
                '/取得工作薄的名称
                sWorkbook = Mid(sTemp(1), InStrRev(sTemp(1), "\") + 1)
            Else
                '/取得工作薄的名称
                sWorkbook = sTemp(1)
            End If
            '/取得工作表的名称
            sSheet = Left(sTemp(2), InStr(sTemp(2), "!") - 1)
            '/取得单元格区域的地址
            sRange = R1C1_To_A1(Mid(sTemp(2), InStr(sTemp(2), "!") + 1))
            '/取得处于剪切或者复制状态的单元格
            Set CutCopyRange = Workbooks(sWorkbook).Sheets(sSheet).Range(sRange)
        End If
        '/解锁 内存
        GlobalUnlock hMem
        
    '/假如未处于复制或者剪切状态
    Else
        Set CutCopyRange = Nothing
    End If
    '/关闭剪切板
    CloseClipboard
    Exit Function
Hanlder:
    Debug.Print Err.Number & Err.Description
End Function
'//--------------------------------------------------------------------------
'//----用于将单元格的R1C1引用样式转换为A1样式------------------
'//--------------------------------------------------------------------------
Private Function R1C1_To_A1(RgStr As String) As String
    Dim sTemp() As String
    If InStr(RgStr, ":") Then
        sTemp = Split(RgStr, ":")
        R1C1_To_A1 = R1C1_To_A1(sTemp(0)) & ":" & R1C1_To_A1(sTemp(1))
    Else
        RgStr = Mid(RgStr, 2)
        sTemp = Split(RgStr, "C")
        R1C1_To_A1 = Chr(64 + sTemp(1)) & sTemp(0)
    End If
End Function