在Windows8以后的系统中，只能使用VBA API操作剪贴板

liucqa

http://www.spreadsheet1.com/how- ... sing-excel-vba.html

Send Information To The Clipboard Using The MS-FORMS Library

Unfortunately, VBA does not offer a clipboard object, although Visual Basic 6 did. Luckily, the MS-Forms 2.0 DataObject object can be used by setting a reference to 'Microsoft Forms 2.0 Object' library. If your VBA project has a userform, then the reference has been already set.

The code snippets shown below work fine in Windows 7 and prior. However, the code copies just two questions marks to the clipboard when used under Windows 8 and 10 (as tested in September 2015). Microsoft recommends using an API workaround.

Option ExplicitSub CopyTextToClipboardDemo()    ' Source: www.Spreadsheet1.com    ' Enable Forms Library: VBE>Tools> References>Microsoft Forms 2.0 Object Library>Check    Dim oClipboard As MSForms.DataObject        Set oClipboard = New MSForms.DataObject    oClipboard.SetText Now    'copy current date/time    oClipboard.PutInClipboardEnd SubFunction CopyToClipboard(sClipText As String) As Boolean    ' Source: www.Spreadsheet1.com    ' Late binding, no Forms Library reference required    Dim MSForms_DataObject As Object    On Error GoTo ErrorHandler_        Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")    MSForms_DataObject.SetText sClipText    MSForms_DataObject.PutInClipboard    CopyToClipboard = TrueExit FunctionErrorHandler_:    CopyToClipboard = FalseEnd FunctionSub Demo()    Debug.Print CopyToClipboard(Now)End SubSub GetTextFromClipboardDemo()    ' Source: www.Spreadsheet1.com    ' Enable Forms Library: VBE>Tools> References>Microsoft Forms 2.0 Object Library>Check    Dim oClipboard As MSForms.DataObject        Set oClipboard = New MSForms.DataObject    oClipboard.GetFromClipboard    Debug.Print oClipboard.GetTextEnd Sub

liucqa

Use An API To Put Text In Windows Clipboard
To use Windows API calls to copy information to the Clipboard read this Microsoft article. The VBA code shown below is a modified version of Microsoft's snippet. The code seems to work just fine in Windows 8 and 10 as tested during September 2015. Error handling has been added to the function in order to return True (text copied) or False (an error occured) to the calling procedure.

The API declarations are compatible with both 32 and 64-bit versions of Office 2010, 2013, 2016.
Option Explicit

#If VBA7 Then
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr

    Declare PtrSafe Function LocalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal wBytes As LongPtr) As LongPtr

    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

    Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

    Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr

    Declare PtrSafe Function GetLastError Lib "kernel32" () As Long
#Else
    Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Declare Function CloseClipboard Lib "User32" () As Long
    Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
    Declare Function EmptyClipboard Lib "User32" () As Long
    Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
    Declare Function wstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
    Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Public Function ClipBoard_SetData(sPutToClip As String) As Boolean

    ' www.msdn.microsoft.com/en-us/library/office/ff192913.aspx

    Dim hGlobalMemory As Long
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    Dim X As Long
   
    On Error GoTo ExitWithError_

    ' Allocate moveable global memory
    hGlobalMemory = GlobalAlloc(GHND, Len(sPutToClip) + 1)

    ' Lock the block to get a far pointer to this memory
    lpGlobalMemory = GlobalLock(hGlobalMemory)

    ' Copy the string to this global memory
    lpGlobalMemory = lstrcpy(lpGlobalMemory, sPutToClip)

    ' Unlock the memory
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Memory location could not be unlocked. Clipboard copy aborted", vbCritical, "API Clipboard Copy"
        GoTo ExitWithError_
    End If

    ' Open the Clipboard to copy data to
    If OpenClipboard(0&) = 0 Then
        MsgBox "Clipboard could not be opened. Copy aborted!", vbCritical, "API Clipboard Copy"
        GoTo ExitWithError_
    End If

    ' Clear the Clipboard
    X = EmptyClipboard()

    ' Copy the data to the Clipboard
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    ClipBoard_SetData = True
   
    If CloseClipboard() = 0 Then
        MsgBox "Clipboard could not be closed!", vbCritical, "API Clipboard Copy"
    End If
    Exit Function
ExitWithError_:
    On Error Resume Next
    If Err.Number > 0 Then MsgBox "Clipboard error: " & Err.Description, vbCritical, "API Clipboard Copy"
    ClipBoard_SetData = False

End Function