Zurück zur Homepage

Array aus Clipboard

Beispieldatei (ArrayClip.zip 17 kB)

Kopiert man Tabellen in die Zwischenablage, werden diese dort als Text abgelegt, wobei die Trennzeichen der Felder ein Tab (vbTab) und das Trennzeichen der Zeilen ein Zeilenvorschub und Wagenrücklauf (vbCrLf) ist.

Das Clipboard kann man ohne Probleme mit ein paar API-Funktionen auslesen. Indem man Split mit dem Trennzeichen vbCrLf benutzt, kann man die einzelnen Zeilen in ein Array umwandeln. Die einzelnen Zeilen kann man wiederum mit Split und dem Zeichen vbTab in weitere Arrays zerlegen.

Man könnte auch vbCrLf mit Replace oder Substitute durch vbTab ersetzen und enthält mit Split dann ein Array mit allen Elementen.

Beide Verfahren haben aber den Nachteil, dass man alle Elemente in das gewünschte zweidimensionale Array umkopieren muss. Das kann bei größeren Arrays schon etwas dauern.

Wenn es aber auf die Anordnung der Daten nicht so genau ankommt (Spalten und Zeilen vertauscht), kann man mit ein paar Manipulationen der Safearraystruktur aus einem eindimensionalen ein zweidimensionales Array machen.

So wird die Funktionalität benutzt:

 

Private Sub cmdCopyFromClip_Click()
Dim varClip As Variant

   Range(
"A1:C13").Select
   
   Selection.Copy
   
   varClip = ArrayFromClip
   
   
If Not (IsArray(varClip)) Then Exit Sub
   
   
' In das Tabellenblatt einfügen
   Me.Range( _
      Me.Cells(5, 5), _
      Me.Cells( _
      5 + 
UBound(varClip, 1), _
      5 + 
UBound(varClip, 2)) _
      ) = varClip
End Sub

Und folgendes gehört in ein Modul:

 Private Declare Sub CopyMemory _
   
Lib "kernel32" Alias "RtlMoveMemory" ( _
   Destination 
As Any, _
   Source 
As Any, _
   
ByVal Length As Long)
Private Declare Function CloseClipboard _
   
Lib "user32" () As Long
Private Declare Function OpenClipboard _
   
Lib "user32" ( _
   
ByVal hWnd As Long _
   ) 
As Long
Private Declare Function GetClipboardData _
   
Lib "user32" ( _
   
ByVal wFormat As Long _
   ) 
As Long
Private Declare Function lstrlen _
   
Lib "kernel32" ( _
   
ByVal str As Long _
   ) 
As Long
Private Declare Function IsClipboardFormatAvailable _
    
Lib "user32" ( _
    
ByVal wFormat As Long _
    ) 
As Long
Private Declare Function GlobalLock _
   
Lib "kernel32" ( _
   
ByVal hMem As Long _
   ) 
As Long
Private Declare Function GlobalUnlock _
   
Lib "kernel32" ( _
   
ByVal hMem As Long _
   ) 
As Long
    
Public Const CF_TEXT = 1

Public Function ArrayFromClip()
Dim lngPointer    As Long
Dim lngMemoryText As Long
Dim strList       As String
Dim lngLen        As Long
Dim lngDimension1 As Long
Dim lngDimension2 As Long
Dim varDummy      As Variant

If IsClipboardFormatAvailable(CF_TEXT) Then

   
' Wenn Text im Clipboard ist,
   
' Clipboard öffnen
   OpenClipboard 0&
   
   
' Handle auf den Datenblock holen
   lngPointer = GetClipboardData(CF_TEXT)
   
   
' Zeiger holen Block und zur Bearbeitung sperren
   lngMemoryText = GlobalLock(lngPointer)
   
   
' Textlänge ermitteln
   lngLen = lstrlen(lngMemoryText)
   
   
' Puffer initialisieren
   strList = String(lngLen, 0)
   
   
' Text in Puffer Kopieren
   CopyMemory 
ByVal strList, ByVal lngMemoryText, lngLen
   
   
' Sperrung aufheben
   GlobalUnlock lngMemoryText
   
   
' Clipboard schließen
   CloseClipboard
   
   
If Right(strList, 2) <> vbCrLf Then
      MsgBox 
"Kein Excel-Array"
      
Exit Function
   
End If
   
   
If InStr(1, strList, vbTab) = 0 Then
      MsgBox 
"Kein Array"
      
Exit Function
   
End If
   
   
' Abschließendes vbCrLf entfernen
   strList = Left(strList, Len(strList) - 2)
   
   
' Dimensionen ermitteln
   varDummy = Split(strList, vbCrLf)
   
If IsArray(varDummy) Then
      
' Zwei Dimesionen
      lngDimension2 = 
UBound(varDummy)
      varDummy = Split(varDummy(0), vbTab)
      lngDimension1 = 
UBound(varDummy)
   
Else
      
' Eine Dimension
      varDummy = Split(strList, vbTab)
      lngDimension1 = 
UBound(varDummy)
   
End If

   strList = Replace(strList, vbCrLf, vbTab)
   
' XL 97
   
' strList = Application.Substitute(strList, vbCrLf, vbTab)
   
   
' In ein eindimensionales Array
   varDummy = Split(strList, vbTab)
   
   
' In ein zweidimensionales Array umwandeln
   varDummy = MakeTwoDimensionsFromOne( _
      varDummy, lngDimension1, lngDimension2)
      
   ArrayFromClip = varDummy
   
End If
End Function
Public Function MakeTwoDimensionsFromOne( _
   myArray 
As Variant, _
   lngDimension1 
As Long, _
   lngDimension2 
As Long _
   ) 
As Variant
Dim lngPtrSafearray  As Long
Dim lngLboundX       As Long
Dim lngLboundY       As Long

If Not (IsArray(myArray)) Then Exit Function

' Zeiger auf die Safearraystruktur ermitteln
CopyMemory lngPtrSafearray, 
ByVal (VarPtr(myArray) + 8), 4

' Ab jetzt wird gelogen!!

' Dimensionen auf zwei
CopyMemory 
ByVal lngPtrSafearray, 2, 2

' Anzahl Elemente in Dimension 2
CopyMemory 
ByVal lngPtrSafearray + 16, lngDimension2 + 1, 4
' LBound Dimension 2
CopyMemory 
ByVal lngPtrSafearray + 20, lngLboundY, 4

' Anzahl Elemente in Dimension 1
CopyMemory 
ByVal lngPtrSafearray + 24, lngDimension1 + 1, 4
' LBound Dimension 1
CopyMemory 
ByVal lngPtrSafearray + 28, lngLboundX, 4

MakeTwoDimensionsFromOne = myArray

End Function