User Tools

Site Tools


vba:clipboard

[VBA] Clipboard

Beispiel wie man dank den API-Funktionen in den Zwischenspeicher schreiben und lesen kann. Ist schon ziemlich alt der Code und von mir nie wieder hinterfragt. Ev. gibts dann mal eine neuere Lösung. Aber diese funktioniert auch noch unter Win7 (hab keine Tests mit Win8)

Code

'-------------------------------------------------------------------------------
'File         : Clipboard
'               mpl by ERB software
'               All rights reserved
'Environment  : Access 2000/XP, VB6
'Version      : 1.0
'Name         : Clipboard Functions
'Description  : uses API to access the Clipboard
'             : http://support.microsoft.com/?kbid=138909
'             : http://support.microsoft.com/?kbid=138910
'Author       : Stefan Erb (ERS)
'History      : 18.10.2004 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
Option Compare Database
 
'-------------------------------------------------------------------------------
' Private members
'-------------------------------------------------------------------------------
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
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function GlobalSize Lib "kernel32" (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 movable 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
 
Function ClipBoard_GetData()
	Dim hClipMemory As Long
	Dim lpClipMemory As Long
	Dim MyString As String
	Dim RetVal As Long
 
	If OpenClipboard(0&) = 0 Then
		MsgBox "Cannot open Clipboard. Another app. may have it open"
		Exit Function
	End If
 
	' Obtain the handle to the global memory
	' block that is referencing the text.
	hClipMemory = GetClipboardData(CF_TEXT)
	If IsNull(hClipMemory) Then
		MsgBox "Could not allocate memory"
		GoTo OutOfHere
	End If
 
	' Lock Clipboard memory so we can reference
	' the actual data string.
	lpClipMemory = GlobalLock(hClipMemory)
 
	If Not IsNull(lpClipMemory) Then
		MyString = Space$(MAXSIZE)
		RetVal = lstrcpy(MyString, lpClipMemory)
		RetVal = GlobalUnlock(hClipMemory)
 
		' Peel off the null terminating character.
		MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
	Else
		MsgBox "Could not lock memory to copy string from."
	End If
 
	OutOfHere:
 
	RetVal = CloseClipboard()
	ClipBoard_GetData = MyString
End Function
vba/clipboard.txt · Last modified: 09.12.2013 09:39:54 (external edit)