Excel 2013 64-bit-VBA: Clipboard-API funktioniert nicht

Ich verwendet, um in der Lage sein, die Verwendung von Windows-API-Aufrufe in Excel VBA text in die Zwischenablage zu kopieren. Aber seit dem Upgrade auf 64-bit-Office 2013, kann ich nicht. Nachfolgend finden Sie einige code, der nicht Fehler, aber es ist auch nicht jeder text in die Zwischenablage. Kann mir jemand helfen, testen und beheben?

Nach dem einfügen den folgenden code in ein code-Modul in VBA, können Sie es testen, in unmittelbarer windows, indem Sie Clipboard_SetData("Copy this to the clipboard.") und es sollte festlegen, dass text in der Zwischenablage, und Sie wäre in der Lage, fügen Sie es in eine andere Anwendung.

(Ich bin mit Windows 8, also kann ich nicht verwenden, Microsoft Forms-oder das Daten-Objekt zur Bearbeitung der Zwischenablage. Es funktioniert nicht richtig unter Windows 8.)

UPDATE und EDIT: Code unten wurde korrigiert und funktioniert jetzt in 64-bit-Excel, Dank Jason Kurtz' Antwort unten. Wenn Sie diese nützlich finden, bitte Stimmen Sie seine Antwort.

Option Explicit

'Found 64-bit API declarations here: http://spreadsheet1.com/uploads/3/0/6/6/3066620/win32api_ptrsafe.txt
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Sub ClipBoard_SetData(MyString As String)
'32-bit code by Microsoft: http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
    Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
    Dim hClipMemory As LongPtr, 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."
       'Debug.Print "GlobalFree returned: " & CStr(GlobalFree(hGlobalMemory))
       GoTo OutOfHere
    End If

    ' Open the Clipboard to copy data to.
    If OpenClipboard(0&) = 0 Then
       MsgBox "Could not open the Clipboard. Copy aborted."
       Exit Sub
    End If

    ' Clear the Clipboard.
    X = EmptyClipboard()

    ' Copy the data to the Clipboard.
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere:
    If CloseClipboard() = 0 Then
       MsgBox "Could not close Clipboard."
    End If
End Sub

Hat die SetClipboardData() Aufruf erfolgreich? Wenn nicht, was bedeutet GetLastError() Bericht?
Habe es gerade ausprobiert. Clipboard_SetData("fjdkla;jfd") \ Debug-Ausgabe: \ hGlobalMemory ist 287253201176 \ lpGlobalMemory ist 287450358016 \ lpGlobalMemory ist 287362598488 \ hClipMemory ist 287253201176 \ LastDLLError-0 \ ist ich Frage mich, warum lstrcopy gibt eine andere Adresse, als GlobalLock. Ich untersuchte die lstrcopy API-Seite und Microsoft warnt uns, es nicht zu verwenden. Ich Frage mich, ob es deaktiviert werden, indem Sie irgendeine Art von Windows 8 Sicherheits-feature. Wer weiß, wie zu StringCchCopy in VBA?
Die genannte Datei 'win32api_ptrsafe.txt" kann jetzt heruntergeladen werden von "Office 2010-Hilfe-Dateien: Win32API_PtrSafe mit 64-bit-Unterstützung' (microsoft.com/en-us/download/details.aspx?id=9970)

InformationsquelleAutor Baodad | 2013-09-07

11

OK, ich hab es jetzt...

Müssen Sie diese Zeile in deiner version des Codes:
```
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As String) As LongPtr
```
:
```
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
```
Wenn Sie Schritt für Schritt durch den code, wie Sie hatte, wirst du sehen, dass der Wert der lpGlobalMemory ändert sich, wenn lstrcopy genannt wird. Wenn die Typen sind verändert, der Wert bleibt der gleiche.

Funktioniert bei mir auf windows 7. Hoffe, es funktioniert für Sie!

Danke, das hat geklappt: und ich beachten Sie, dass Sie über einen Zeiger als Rückgabetyp nicht ein long integer - gibt es code auf anderen Seiten mit Langen oder LongLong, die gut funktionieren wird, bis es nicht.

InformationsquelleAutor Jason Kurtz

Posting vollständige code für den anderen.
Getestet und funktioniert auf 32-Bit-Versionen von Excel 2007, 2010, 2013, 2016
und 64-Bit-Excel 2013
Laufen alle auf Windows 10

 'http://stackoverflow.com/questions/14738330/office-2013-excel-putinclipboard-is-different
Option Explicit
#If VBA7 Then
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    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 CloseClipboard Lib "User32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
    Declare PtrSafe Function lstrcpy Lib "kernel32" (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
#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 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

Function ClipBoard_SetData(MyString As String)
   #If VBA7 Then
      Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr, hClipMemory As LongPtr
   #Else
      Dim hGlobalMemory As Long, lpGlobalMemory As Long, hClipMemory As Long
   #End If
   Dim 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. Please contact 14Fathoms."
      GoTo OutOfHere2
   End If

   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted. Please contact 14Fathoms."
      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. Please contact 14Fathoms."
   End If

End Function
Sub TestCOPYPASTE()
    Call ClipBoard_SetData("Hello World " & now())
    'Open notepad or in the immediate window and hit control-v
End Sub

InformationsquelleAutor michaelf

Verwenden Sie den code exakt so, wie hier gezeigt:

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

außer insert PtrSafe nach Deklarieren, die für alle API-Deklarationen.

Der code sollte in ein Modul von selbst.

Wie diese:

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

Dieser code funktioniert nicht in 64-bit-Version von Excel 2013. Die kernel32-API-Deklarationen sind nicht LongPtr. Es Fehler in GlobalUnlock. Mein code im Hauptteil der Frage nicht auf Fehler und die APIs deklariert werden, für 64-bit. Aber danke für den Versuch.

InformationsquelleAutor Jason Kurtz

Schreibe einen Kommentar

Du musst angemeldet sein, um einen Kommentar abzugeben.