如何在vba中用api函数操作剪贴板Clipboard?

用api函数操作剪贴板Clipboard主要集中在读取剪贴板数据和将数据写入剪贴板两种。

用api函数将数据写入剪贴板主要的步骤为:

1.用GlobalAlloc函数分配内存空间

2.用GlobalLock函数锁定分配的内存空间

3.用CopyMemory函数将要写入的数据复制到分配的内存空间

4.用GlobalUnlock函数解锁内存空间

5.用OpenClipboard函数打开剪贴板

6.用EmptyClipboard函数清空剪贴板

7.用SetClipboardData函数设置剪贴板的数据格式和关联步骤1-4中分配的内存空间

8.用CloseClipboard函数关闭剪贴板

如以下是一个将字符串“我和你”复制到剪贴板中的代码:

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetClipboardData Lib "user32" (ByVal Format As Long, ByVal hMem As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal Flags As Long, ByVal length As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSource As Long, ByVal length As Long)
Const CF_TEXT = 1
Const CF_UNICODETEXT = 13
Const GHND = &H42
Sub QQ1722187970()
    Dim str1 As String
    '要放到剪贴板中的字符串
    str1 = "我和你"
    Dim hMem As Long
    '内存对象的句柄
    hMem = GlobalAlloc(GHND, LenB(str1) + 2)
    Dim lHwnd As Long
    '锁定内存块,获取内存对象的第一个字节的内存地址
    lHwnd = GlobalLock(hMem)
    '将字符串至于剪贴板内存中
    CopyMemory lHwnd, StrPtr(str1), LenB(str1) + 2
    '解锁内存块
    GlobalUnlock (hMem)
    OpenClipboard (0)
    EmptyClipboard
    '关联剪贴板对象到指定的内存句柄
    SetClipboardData CF_UNICODETEXT, hMem
    CloseClipboard
    Debug.Print VBA.Hex(lHwnd), VBA.Hex(StrPtr(str1))
End Sub

用api函数将数据读取剪贴板数据的主要步骤为:

1.用OpenClipboard函数打开剪贴板

2.用GetClipboardData函数获取要读取的数据所在的内存对象的句柄

3.用GlobalLock函数锁定获得的内存对象,并返回内存对象的第一个内存字节的地址

4.用GlobalSize函数获得实际存储数据的字节数

5.用CopyMemory函数将剪贴板内存对象中的数据读取到变量中

6.用CloseClipboard函数关闭剪贴板

以下代码是读取上面的写入剪贴板的数据:

Sub QQ1722187970()
    '定义一个字符串变量用于存放从剪贴板中获得数据
    Dim str1 As String
    OpenClipboard (0)
    Dim hMem As Long
    hMem = GetClipboardData(CF_UNICODETEXT)
    Dim lHwnd As Long
    lHwnd = GlobalLock(hMem)
    Dim bSize As Long
    bSize = GlobalSize(hMem)
    '设置缓冲区
    str1 = Space(bSize / 2)
    CopyMemory StrPtr(str1), lHwnd, bSize
    MsgBox str1
    CloseClipboard
End Sub
       

发表评论