Beiträge zum Thread: Problem mit 2-spaltiger Listbox

Option Explicit



#If VBA7 Then

    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 objGlobSpeicher Lib "kernel32.dll" Alias "GlobalFree" (ByVal hMem As LongPtr) As LongPtr

    Private Declare PtrSafe Function strCopy Lib "kernel32.dll" Alias "lstrcpy" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long

    Private Kennung As LongPtr

#Else

    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long

    Private Declare Function CloseClipboard Lib "user32" () As Long

    Private Declare Function EmptyClipboard Lib "user32" () As Long

    Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

    Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

    Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long

    Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long

    Private Declare Function objGlobSpeicher Lib "kernel32.dll" Alias "GlobalFree" (ByVal hMem As Long) As Long

    Private Declare Function strCopy Lib "kernel32.dll" Alias "lstrcpy" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long

    Private Kennung As Long

#End If



Private Sub StringInClipboard(strText As String)

    Kennung = GlobalAlloc(2, Len(strText) + 1)

    strCopy GlobalLock(Kennung), strText

    GlobalUnlock Kennung

    OpenClipboard 0&

    EmptyClipboard

    SetClipboardData 1&, Kennung

    CloseClipboard

    objGlobSpeicher Kennung

End Sub



Public Sub Einlesen()

    Dim rngWerte$, i&

    For i = 1 To 4

        rngWerte = rngWerte & Tabelle1.Cells(i, 6) & vbCrLf

    Next i

    StringInClipboard rngWerte

End Sub