Danke klappt wunderbar
18.05.2003 18:04:29
Roger
Hallo Rainer
Hab im Buch Excel vBA Programierung noch was gefunden und diesen Code abgeändert. Da ich nach deinem Code wusste nach was ich suchen musste hat es geklappt. Ich stelle den Coe hier rein vielleicht hat ja noch jemand anders Interesse daran.Private Sub test_Click()
Dim WordObj As Object
Dim Bereich As Variant
Dim WordDoc As Object
Dim ExTab As Object
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim arrWks()
Dim iCounter As Integer, iCount As Integer
For iCounter = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(iCounter) Then
Worksheets(ListBox1.List(iCounter)).Activate
End If
Next iCounter
i = ActiveSheet.UsedRange.Rows.Count
Bereich = Range("A4:F" & i).Value
On Error Resume Next
Set WordObj = GetObject(, "word.application.9")
If Err.Number = 429 Then
Set WordObj = CreateObject("word.application.9")
Err.Number = 0
End If
WordObj.Visible = True
Set WordDoc = WordObj.Documents.Add
Set ExTab = WordDoc.Tables.Add _
(WordObj.Selection.Range, UBound(Bereich, 1), UBound(Bereich, 2))
With ExTab
For x = 1 To UBound(Bereich, 1)
For y = 1 To UBound(Bereich, 2)
.Cell(x, y).Range.InsertAfter Bereich(x, y)
Next y
Next x
End With
Set WordObj = Nothing
Set WordDoc = Nothing
Set ExTab = Nothing
Worksheets("Hilfsblatt").Activate
End Sub
Besten Dank nochmals
Gruss Roger