01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45 |
|
' (c) 01.07.2024 Volti, Freigericht
' ############### In ein allgemeines Modul #############
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock 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 lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
ByVal hMem As LongPtr) As LongPtr
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
Function KopiereinClpbrd(Optional ClpTxt As String) As String
' Kopieren über die API
Dim hMem As LongPtr, lpGMem As LongPtr
hMem = GlobalAlloc(&H42, Len(ClpTxt) + 1) ' Speicher reservieren &H42=GMEM_MOVEABLE + GMEM_ZEROINIT
lpGMem = GlobalLock(hMem) ' Speicherbereich blocken
lpGMem = lstrcpy(lpGMem, ClpTxt) ' Text in Speicher übertragen
If GlobalUnlock(hMem) = 0 Then ' Speicherbereich unblocken
If OpenClipboard(0&) <> 0 Then ' Zwischenablage öffnen
EmptyClipboard ' Zwischenablage leeren
SetClipboardData 1, hMem ' 1=CF_TEXT Daten dort rein
CloseClipboard ' Zwischenablage schließen
End If
End If
End Function
' ############### In irgendein Modul #############
Sub Copytest()
' Vorheriger Makroteil
Dim EQNR As String
EQNR = "12345678" ' kommt im Makro aus vorherigem Makroteil
KopiereinClpbrd EQNR
' Nachvolgender Makroteil
End Sub
|