Excel-Range als Werte in die Zwischenablage kopieren

[volti]

Liebe Leserin, lieber Leser,

immer wieder liest man den Wunsch, einen Range-Bereich in Excel zu kopieren und als Werte wieder einzufügen, ggf. auch in andere Anwendungen.

Bei der Kopie in die Zwischenablage werden dort mehrere Formate vorgehalten. Das Format der Einfügung aus der Zwischenablage hängt vom Empfängerprogramm ab.
Werden die Excelformate unterstützt, wird dieses Format dann auch eingefügt.

Natürlich kann man in einer Schleife alle Zellen durchgehen und die Values in einer Stringvariablen sammeln und der Zwischenablage übergeben
oder ggf. die Funktion "Worksheetfunction.TextJoin" einsetzen.

Hier mal eine Idee über die Windows-API, die sehr schnell den gewünschten Bereich kopiert und als Ergebnis beim Einfügen dann nur Texte liefert.

Code:

Option Explicit

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
               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 Range("A1:C100")
End Sub

_________
viele Grüße
Karl-Heinz