Forumbeitrag
Excel-Version des Fragestellers:
365 Business
Erfahrungslevel des Fragestellers:
Excel gut - VBA bescheiden
eine Beispiellösung per API:
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
Gruß Uwe