Problem bei Paste

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Problem bei Paste
von: Micha
Geschrieben am: 19.11.2003 09:51:22

Hallo!
Habe ein Spreadsheet in einer Userform und möchte mit einem Button "Einfügen" paste aus der Zwischenablage machen. Aber die Zwischenablage kopiert sich komplett in die Zelle, sie soll sich aber in die Spalte kopieren.

was mache ich falsch?


Private Sub CommandButton1_Click()
With Spreadsheet1.ActiveSheet
Set Zwischenablage = New DataObject
Zwischenablage.GetFromClipboard
On Error GoTo Errorhandler
'Spreadsheet1.Cells(2, 1).Activate
Spreadsheet1.ActiveCell.Value = Zwischenablage.GetText
On Error GoTo Errorhandler
Set Zwischenablage = Nothing
Exit Sub
Errorhandler:
MsgBox "Zwischenablage ist leer! Bitte kopieren sie Ihre Daten durch Rechtklick der Maus > Kopieren!"
Exit Sub
End With
End Sub

Bild


Betrifft: AW: Problem bei Paste
von: Nayus
Geschrieben am: 19.11.2003 11:09:22

Hi,
da der Inhalt der Zwischenablage als Zeichenkette vorliegt, muss diese
Zeichenkette geparst werden.
Hilfreich ist, dass die einzelnen Zellinhalte durch ein TAB-Zeichen voneinander
getrennt sind.
Am Ende der Zeichenkette steht ein kompletter Zeilenumbruch (CHR(10)+CHR(13)), der
nicht in die Zelle geschrieben werden darf.
Nachfolgend ein Parser für die Zwischenablage.
Falls englisches EXCEL verwendet wird, müssen beim Schreiben in die Zellen bei Dezimalzahlen noch "," und "." getauscht werden!

Gruß,
Nayus

Dim Zwischenablage As DataObject


Sub getDataFromClipboard()
On Error GoTo Errorhandler
Dim strBuff, cellBuff As String
Dim iStartCol, iRow, iOffset As Integer
Set Zwischenablage = New DataObject
iOffset = 0
Zwischenablage.GetFromClipboard
strBuff = Zwischenablage.GetText(1)
iStartCol = ActiveCell.Column
iRow = ActiveCell.Row
' Inhalte der Zwischenablage parsen
For i = 1 To Len(strBuff)
 If Asc(Mid(strBuff, i, 1)) = 9 Then
   'Zellinhalt wegschreiben; die Zellinhalte sind durch TAB (chr(9) getrennt
   ActiveSheet.Cells(iRow, iStartCol + iOffset) = chrBuff
   chrBuff = ""
   iOffset = iOffset + 1
 Else
   chrBuff = chrBuff & CStr(Mid(strBuff, i, 1))
 End If
Next i
'Inhalt der letzen Zelle wegschreiben; chr(10)+chr(13) am Ende Ignorieren
ActiveSheet.Cells(iRow, iStartCol + iOffset) = Mid(chrBuff, 1, Len(chrBuff - 2))
Set Zwischenablage = Nothing
Exit Sub
Errorhandler:
 MsgBox "Zwischenablage ist leer! Bitte kopieren sie Ihre Daten durch Rechtklick der Maus > Kopieren!"
 Exit Sub
End Sub



Bild

Beiträge aus den Excel-Beispielen zum Thema " Problem bei Paste"