Zwischenablage per VBA, 64-Bit-Version

Den Code für die Ablage von Inhalten per VBA in die Zwischenablage benötigt man immer wieder. Dieser Artikel zeigt die notwendigen Änderungen für die 64-Bit-Version.

Seit Microsoft das Office-Paket standardmäßig in der 64-Bit-Version installiert, kracht es regelmäßig bei Datenbanken, die mit der 32-Bit-Version programmiert wurden und die API-Funktionen verwenden.

Das gilt auch für die Funktion InZwischenablage, die wir schon in zahlreichen Beispielen verwendet haben. Wir haben das Modul mit dieser Funktion erweitert, sodass es sowohl unter 64-Bit-Office als auch unter 32-Bit-Office funktioniert. Damit Sie einmal sehen, welche Änderungen nötig sind, haben wir diese in den Listings fett hervorgehoben. Listing 1 enthält den Teil, der durch die Kompiler-Bedingung #If Win64 Then im Falle der 64-Bit-Version von Office kompiliert und verwendet wird. Hier finden Sie die API-Deklarationen mit dem PtrSafe-Schlüsselwort vor, außerdem wurden einige Long-Variablen durch LongPtr ersetzt. Das zeigt auch, dass man nicht einfach alle Long-Elemente durch LongPtr ersetzen kann!

'Original aus http://support.microsoft.com/kbid=210216
#If Win64 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 Long) 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" (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
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function Inzwischenablage(MyString As String)
   Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
   Dim hClipMemory As LongPtr, X As Long
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
   lpGlobalMemory = GlobalLock(hGlobalMemory)
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo OutOfHere2
   End If
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If
   X = EmptyClipboard()
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If
End Function

Sie haben das Ende des frei verfügbaren Textes erreicht. Möchten Sie ...

Workplace

Jahresabonnement TestzugangOder haben Sie bereits Zugangsdaten? Dann loggen Sie sich gleich hier ein:

Schreibe einen Kommentar