AW: Zellwert statt Inhalt in Zwischenablage
07.11.2023 11:44:25
volti
Hallo MCO,
Excel kopiert, wie andere Apps auch, mehrere Formate in die Zwischenablage. Kann man bei Bedarf nach einer Kopie über die API EnumClipboardFormats ermitteln.
Aus diesen bereitgestellten verschiedenen Formaten kann der User dann z.B. nur die Textversion einfügen, wie Du schon angeführt hast.
Man kann aber auch nur Text kopieren, neben der eben gezeigten Version hier noch eine API-Version. Allerdings kann hier im vorliegenden Fall nur der Inhalt einer Zelle und keine Range kopiert werden.
Code:
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 OpenClipboard Lib "user32" ( _
ByVal hWnd As LongPtr) 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 CloseClipboard Lib "user32" () As Long
Sub KopiereTextInZwischenablageAPI()
' Kopieren von Text über die API
Dim hMem As LongPtr, lpGMem As LongPtr, sCliptext As String
sCliptext = ActiveCell.Value
hMem = GlobalAlloc(&H42, Len(sCliptext) + 1)
lpGMem = GlobalLock(hMem)
lpGMem = lstrcpy(lpGMem, sCliptext)
If GlobalUnlock(hMem) = 0 Then
If OpenClipboard(0&) <> 0 Then
EmptyClipboard
SetClipboardData 1, hMem ' 1=CF_TEXT
CloseClipboard
End If
End If
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz