前几天分享了博文《 如何使用VBA将变量值拷贝到剪贴板？ 》，有的网友觉得使用的是旁门左道，今天来个根正苗红的Windows API解决方案。
示例代码如下。

Private Declare Function GlobalAlloc Lib _
                "kernel32.dll" (ByVal wFlags As Long, _
                            ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib _
                "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib _
                "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib _
                "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib _
                "kernel32.dll" Alias "lstrcpyW" _
                (ByVal lpString1 As Long, _
                ByVal lpString2 As Long) As Long
Private Declare Function OpenClipboard Lib _
                "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib _
                "user32.dll" () As Long
Private Declare Function CloseClipboard Lib _
                "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib _
                "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib _
                "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib _
                "user32.dll" (ByVal wFormat As Long, _
                            ByVal hMem As Long) As Long
Public Function GetFromClipboard() As String
    Dim lngPtr      As Long
    Dim lngLength   As Long
    Dim lngGLock    As Long
    Dim strTxt      As String
    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        lngPtr = GetClipboardData(CF_UNICODETEXT)
        If lngPtr Then
            lngGLock = GlobalLock(lngPtr)
            lngLength = GlobalSize(lngPtr)
            strTxt = String$(lngLength \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(strTxt), lngGLock
            GlobalUnlock lngPtr
        End If
        GetFromClipboard = strTxt
    End If
    CloseClipboard
End Function
Public Sub SetToClipboard(strTxt As String)
    Dim lngPtr      As Long
    Dim lngLength   As Long
    Dim lngGLock    As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    lngLength = LenB(strTxt) + 2&
    lngPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, lngLength)
    lngGLock = GlobalLock(lngPtr)
    lstrcpy lngGLock, StrPtr(strTxt)
    GlobalUnlock lngPtr
    SetClipboardData CF_UNICODETEXT, lngPtr
    CloseClipboard
End Sub
由于代码使用了多个API函数，并且涉及指针的概念，这里不再进行详细讲解，接下来看一下如何使用。
 
Sub Demo()
    Dim strMsg As String
    strMsg = "2021年"
    SetToClipboard strMsg
    ActiveSheet.[a1].Select
    ActiveSheet.Paste
    ActiveSheet.[a2].Value = GetFromClipboard
End Sub
【代码解析】
 SetToClipboard 将程讲变量strMsg的值放置到系统剪贴板，在此之后可以使用第7行代码进行粘贴，也可以用9行代码直接为单元格赋值。当然也可以在其他应用程序中粘贴。
                                    VBA操作剪切板一，利用MsForms.DataObject操作1，什么是DataObject对象2，用vba操作剪切板注意3，声明方式4，文本写入剪切板5，读取剪切板文本二，利用API操作剪切板1，用到得API函数2，写入剪切板3，读取4， 提取剪贴板所有数据格式的代码5，整理一个上面用得全部api
一，利用MsForms.DataObject操作
1，什么是DataObject对象
传输操作中使用的格式化文本数据的保留区域。 还保留 DataObject 中存储的文本块所对应的 格式 的列表
DataO
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets
        ws.Range("G:G").Cut Destination:=ws.Range("A1")
    Next ws
End Sub
使用该代码，您可以在当前Excel工作簿的所有工作...
                                    我可以提供一个关于如何使用 VBA 代码将剪贴板内容粘贴在光标位置的示例：Sub PasteFromClipboard()
    'Inserts text from the clipboard into the active worksheet at the cursor location
    ActiveSheet.Paste
End Sub
                                    VBA中使用Excel拷贝和粘贴方法是很容易的，并且很多时候为了提升代码运行效率，应尽量避免在代码中使用拷贝和站，而应优先采用直接赋值的方法。
不可否认，有些应用场景中仍然需要将某些内容放置到剪贴版中，这样可以供其他应用程序使用，如果内容已经在单元格中，那么直接使用Range对象的Copy方法就可以，但是如果内容是保存在变量中，是否可以直接放置到剪贴板，而不使用单元格做中转呢？答案是肯定的。
TextBox1.Text = My.Computer.Clipboard.GetText
这是获取图形信息：
PictureBox1.Image = My.Computer.Clipboard.GetImage
                                    在VBA中经常使用以下语句，来复制文本到剪贴板，但有时会出错。　 Dim MyData As New DataObject     MyData.SetText sData, 1     MyData.PutInClipboard为了复制文本到剪贴板更加稳定，应该调用API来处理：复制文本到剪贴板Public Sub CopyTextToClip(sData As String)   If