Kästchen und chr(10)
08.10.2003 16:18:47
Vladi
ich habe da folgendes Problem:
eine Tabelle in Word soll 1:1 nach Excel übertragen werden (fragt mich bitte nicht, warum!), und zwar so, dass sie dann in Excel weiterbearbeitet werden kann. Objekt einfügen geht also nicht.
Folgenden Makro habe ich schon erstellt (und zugegebenermassen teilweise zusammengeklaut...). Das Problem: in Excel werden die Zeilenumbrüche nicht erkannt, stattdessen stehen da dann Quadrate. Beim markieren des Textes in einer Zelle und anschliessendem kopieren erkennt Excel dann die Formatierungszeichen, nicht jedoch, wenn man die Zelle als ganzes kopiert(sieht es dann als Zeichenkette an). Wie kann ich das ändern?
zum selber ausprobieren und kopieren hier der code, wobei die Spalten von A-F gehen und auch etwa diese Grösse haben sollen.
Sub Makro1()
Dim Excel As Object
Dim sheet As Object
Dim tbl As Object
Dim rng As Object
Dim arr() As Variant
Dim i As Integer, k As Integer
Set wd = GetObject(, "Word.Application")
Set doc = wd.ActiveDocument
Set tbl = doc.Tables(1)
With tbl
ReDim arr(.Rows.Count, .Columns.Count)
For i = 1 To .Rows.Count
Set rng = tbl.Rows(i).Range
For k = 1 To rng.Columns.Count
arr(i - 1, k - 1) = rng.Cells(k).Range.Text
Next k
Next i
End With
Set wd = Nothing
Dim xl As Object
Set xl = CreateObject("Excel.Application")
xl.Application.Visible = True
xl.WindowState = -4137
xl.Application.Workbooks.Add
xl.Windows(1).Activate
With xl.Application
.Range(.Cells(1, 1), .Cells(UBound(arr, 1), UBound(arr, 2))) = arr
.Columns("A:A").Select
.Selection.ColumnWidth = 8
.Columns("B:B").Select
.Selection.ColumnWidth = 40
.Columns("C:C").Select
.Selection.ColumnWidth = 8
.Columns("D:D").Select
.Selection.ColumnWidth = 15
.Columns("E:E").Select
.Selection.ColumnWidth = 6
.Columns("F:F").Select
.Selection.ColumnWidth = 40
.Cells.Select
.Selection.Rows.AutoFit
.Columns("A:A").Select
With .Selection
.WrapText = True
End With
.Columns("B:B").Select
With .Selection
.WrapText = True
End With
.Columns("C:C").Select
With .Selection
.WrapText = True
End With
.Columns("D:D").Select
With .Selection
.WrapText = True
End With
.Columns("E:E").Select
With .Selection
.WrapText = True
End With
.Columns("F:F").Select
With .Selection
.WrapText = True
End With
End With
Set xl = Nothing
End
Sub
Für Hilfe wäre ich echt dankbar, dafür erhebe ich auch keine Urheberrechtsansprüche auf meinen Makro ;-) .
Grüssle
Vladi