使用WinAPI剪贴板函数获取Excel复制区域地址

lss001

' 获取Excel复制区域地址

Private Declare PtrSafe Function OpenClipboard _
    Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData _
    Lib "user32" ( _
    ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function GlobalSize _
    Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalLock _
    Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory _
    Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As LongPtr)
Private Declare PtrSafe Function GlobalUnlock _
    Lib "kernel32" ( _
    ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard _
    Lib "user32" () As Long


Private Sub 获取Excel复制区域地址()
    Dim cp As LongPtr, p As LongPtr, s$, t$
    Dim arr() As Byte, n As Long, Rng As Range

    If Application.CutCopyMode = xlCopy Then '判断
        OpenClipboard 0 '打开
        cp = GetClipboardData(49154) '数据
        If CBool(cp) Then
            p = GlobalLock(cp) '锁定
            n = GlobalSize(cp) '大小
            If p <> 0 Then
                ReDim arr(n) '声明
                CopyMemory arr(0), ByVal p, n '复制
                s = StrConv(arr, vbUnicode) '转换
                t = Split(s, Chr(0))(2) '拆分
            End If
            GlobalUnlock cp '解锁
        End If
    End If

    CloseClipboard '关闭
    On Error GoTo t
    t = Split(t, "!")(1) '获取
    Set Rng = Range(Application.ConvertFormula(t, xlR1C1, 1))
t:
End Sub

sj15627581616

好奇这个代码是应用在什么场景？