AW: Leerzeichen beim kopieren einer Excel Zelle entfernen
05.09.2025 11:21:35
volti
Hallo mcKater,
vielen Dank für Deine Beiträge.
Ich hatte ja schon geschrieben, was sich am Ende der kopierten Daten befindet:
Für alle Interessierten hier ein Kopiercode zum Kopieren von Text.
Ich gebe dort einfach mal die letzten drei Zeichen der Daten in der Zwischenablage aus.
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 GlobalSize 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 IsClipboardFormatAvailable Lib "user32" ( _
ByVal wFormat As Long) As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" ( _
ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" ( _
ByVal wFormat As Long) 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 KopiereRangeAlsText(Rng As Range) As String
' Kopiert eine Excelrange in die Zwischenablage und hält sie dort als Text
Dim hMem As LongPtr, lpGMem As LongPtr, sCliptext As String, i As Long
Const CF_TEXT As Long = 1
Rng.Copy
DoEvents
If IsClipboardFormatAvailable(CF_TEXT) > 0 Then ' Daten vorhanden?
For i = 1 To 2
OpenClipboard 0& ' Zwischenablage öffnen
If i = 1 Then hMem = GetClipboardData(CF_TEXT) ' TEXT aus Zwischenablage
If i = 2 Then hMem = GlobalAlloc(&H42, Len(sCliptext)) ' Speicher reservieren
If hMem > 0 Then
lpGMem = GlobalLock(hMem) ' Speicher blockieren
If i = 1 Then
sCliptext = Space(CLng(GlobalSize(hMem))) ' Platz reservieren
lstrcpy sCliptext, lpGMem ' Daten kopieren
GlobalUnlock hMem ' Speicher freigeben
EmptyClipboard ' Zwischenablage leeren
Else
Dim n As Long
For n = Len(sCliptext) - 2 To Len(sCliptext)
Debug.Print Asc(Mid(sCliptext, n, 1))
Next n
sCliptext = Left(sCliptext, Len(sCliptext) - 3) & vbNullChar
lpGMem = lstrcpy(lpGMem, sCliptext) ' Daten kopieren
If GlobalUnlock(hMem) = 0 Then _
SetClipboardData CF_TEXT, hMem ' TEXT in Zwischenablage
End If
End If
CloseClipboard ' Zwischenablage schließen
Next i
End If
End Function
' ###############################################
Sub Test()
KopiereRangeAlsText Selection
End Sub
Gruß
Karl-Heinz
