Office: aus Exl heraus Word Tabelle zeichnen und erweiterm um Zeilen

Hallo,

wie kann ich von Excel heraus Tabellenzeilen in Word zeichnen und nach unten erweitern.
Dann sollen noch die Zellen beschriftet werden bzw. mit Inhalt aus Excelzellen befüllt werden.

vielen Dank für Eure Hilfe
paule

 

Hallo Paule,

das folgende Makro beruht auf "Early Binding", d.h. es muss, damit es fehlerfrei ausgeführt werden kann, ein Verweis auf die "Microsoft Word ... Object Library" gesetzt werden:
und zwar im VBA-Editor Menü "Extras > Verweise..." muss in der Liste der verfügbaren Verweise die "Microsoft Word 11.0 Object Library" mit einem Häkchen versehen werden.

Ich habe genügend Kommentar eingefügt, um das Makro zu verstehen.

Code:

Option Explicit

'Damit folgendes Makro funktioniert, muss ein Verweis
'auf "Microsoft Word .... Object Library" gesetzt werden:
'
'im VBA-Editor Menü: Extras > Verweise...
'
Sub Word_erzeugen()

  Dim WApp As Word.Application
  Dim WDoc As Word.Document
  Dim WTab As Word.Table
  Dim WRng As Word.Range
  Dim WRow As Word.Row
  Dim Zl As Integer, Sp As Integer
  
  'Erstellen einer Instanz der Word-Applikation
  Set WApp = New Word.Application
  'Hinzufügen eines leeren Dokumentes zur Word-Instanz
  Set WDoc = WApp.Documents.Add(NewTemplate:=False, DocumentType:=wdNewBlankDocument)
  'Anzeigen des leeren Dokumentes
  WApp.Visible = True
  'Aktivieren
  WApp.Activate
  
  'Marke auf das Ende des Dokumentes stellen
  Set WRng = WDoc.Content
  WRng.Collapse Direction:=wdCollapseEnd
  
  'Tabelle mit 3 Zeilen und 5 Spalten erzeugen und am Dokumentende einfügen
  Set WTab = WDoc.Tables.Add(Range:=WRng, NumRows:=3, NumColumns:=5)
  With WTab
      'Text in die Tabellenzellen von Word einfügen
      'und zwar aus den Zellen A1:E3 des aktiven Excel-Arbeitsblattes
      For Zl = 1 To 3
        For Sp = 1 To 5
          .Cell(Zl, Sp).Range.InsertAfter Text:=ActiveSheet.Cells(Zl, Sp).Value
        Next Sp
      Next Zl
      'Anpassen der Word-Tabellenspalten an ihre Inhalte
      .Columns.AutoFit
      
      'Anfügen einer 4. Zeile an die vorhandenen 3 Zeilen
      Set WRow = .Rows.Add
      'Befüllen der 4. Zeile mit Text
      For Sp = 1 To 5
        WRow.Cells(Sp).Range.InsertAfter Text:="Zeile S" & Sp
      Next Sp
      
  End With
End Sub