AW: In Zwischenablage kopieren
10.09.2021 08:46:17
Nepumuk
Hallo Fanny,
teste mal:
Option Explicit
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
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 GlobalAlloc Lib "kernel32.dll" ( _
ByVal wFlags As Long, _
ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" ( _
ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" ( _
ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalFree Lib "kernel32.dll" ( _
ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" ( _
ByVal lpStr1 As Any, _
ByVal lpStr2 As Any) As LongPtr
Private Const CF_TEXT As Long = 1&
Private Const GMEM_MOVEABLE As Long = 2
Private Sub StringToClipboard(strText As String)
Dim lngptrIdentifier As LongPtr, lngptrPointer As LongPtr
lngptrIdentifier = GlobalAlloc(GMEM_MOVEABLE, CLngPtr(Len(strText) + 1))
lngptrPointer = GlobalLock(lngptrIdentifier)
Call lstrcpy(ByVal lngptrPointer, strText)
Call GlobalUnlock(lngptrIdentifier)
Call OpenClipboard(CLngPtr(0))
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngptrIdentifier)
Call CloseClipboard
Call GlobalFree(lngptrIdentifier)
End Sub
Public Sub Schaltfläche1_Klicken()
Call StringToClipboard(ActiveSheet.Shapes("Textfeld 1").OLEFormat.Object.Text)
End Sub
Es kann sein, dass ich dir das auf 32Bit umbauen muss.
Gruß
Nepumuk