Excel 2013 64-bit VBA: Clipboard API doesn't work

后端 未结 3 590
北恋
北恋 2020-12-08 22:01

I used to be able to use Windows API calls in Excel VBA to set text on the clipboard. But ever since upgrading to 64-bit Office 2013, I cannot. Below is some code that doe

3条回答
  •  离开以前
    2020-12-08 22:41

    Use the code exactly as shown here:

    http://msdn.microsoft.com/en-us/library/office/ff192913.aspx

    except insert PtrSafe after Declare for all the API declarations.

    The code should be in a module by itself.

    Like this:

    Option Explicit
    
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
       As Long
    Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
       As Long
    Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
       ByVal dwBytes As Long) As Long
    Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
       As Long
    Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
    Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
       ByVal lpString2 As Any) As Long
    Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
       As Long, ByVal hMem As Long) As Long
    
    Public Const GHND = &H42
    Public Const CF_TEXT = 1
    Public Const MAXSIZE = 4096
    
    Function ClipBoard_SetData(MyString As String)
       Dim hGlobalMemory As Long, lpGlobalMemory As Long
       Dim hClipMemory As Long, X As Long
    
       ' Allocate moveable global memory.
       '-------------------------------------------
       hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 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, MyString)
    
       ' Unlock the memory.
       If GlobalUnlock(hGlobalMemory) <> 0 Then
          MsgBox "Could not unlock memory location. Copy aborted."
          GoTo OutOfHere2
       End If
    
       ' Open the Clipboard to copy data to.
       If OpenClipboard(0&) = 0 Then
          MsgBox "Could not open the Clipboard. Copy aborted."
          Exit Function
       End If
    
       ' Clear the Clipboard.
       X = EmptyClipboard()
    
       ' Copy the data to the Clipboard.
       hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    
    OutOfHere2:
    
       If CloseClipboard() = 0 Then
          MsgBox "Could not close Clipboard."
       End If
    
       End Function
    

提交回复
热议问题