Office: (Office 365) [Excel, VBA] Daten aus Excel-Bereich in Word Tabelle einfügen

Hallo zusammen,

ich stehe im Augenblick vor folgendem Problem.

Habe in einem Excelsheet einen Bereich (5 Spalten, 2 Zeilen) mit Daten, dessen Inhalt ich gerne in ein Word-Dokument in eine Tabelle (5 Spalten, 2 Zeilen) einfügen möchte. Hierzu verwende ich eine For-Schleife, die alle Daten aus dem Excel Sheet einsammelt, jedoch immer nur eine Spalte in der Tabelle im Word Dokument befüllt.

Was mache ich falsch?

Hier ist der gesamte Code.

Danke im Voraus für eure Tipps.

LG,
denpei

Code:

Option Explicit

Sub Export()

    'Name der Dokumentenvorlage
    Const stWordDocument As String = "Test_Word.docx"

    'Bibliothek aktivieren
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim wdCell As Word.Cell
    
    'Excel Objekte
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    Dim lnCountItems As Long
    
    'Variable Device definieren
    Dim Device As Variant
    
    'Variablen-Bezüge definieren
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Tabelle1")
    Device = Tabelle1.Range("B10:F11").Value
    
    'Word-Datei öffnen
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
    
    'Daten aus Device Tabelle in Word einfügen
    lnCountItems = 1
    
    For Each wdCell In wdDoc.Tables(3).Columns(1).Cells
        wdCell.Range.Text = Device(lnCountItems, 1)
        lnCountItems = lnCountItems + 1
    Next wdCell
    
    'Bookmarks befüllen
    wdDoc.Bookmarks("Manu").Range.Text = Tabelle1.Range("B6").Value
    wdDoc.Bookmarks("MatN").Range.Text = Tabelle1.Range("B7").Value
    wdDoc.Bookmarks("MatN2").Range.Text = Tabelle1.Range("B7").Value
    wdDoc.Bookmarks("SW").Range.Text = Tabelle1.Range("B4").Value
    wdDoc.Bookmarks("Reg").Range.Text = Tabelle1.Range("B8").Value
    
    'Word-Datei abspeichern
    wdDoc.SaveAs2 ThisWorkbook.Path & "\\Anforderungen_Materialzugang_" & Tabelle1.Range("B6").Value & "_" & Format(Now, "yyyy-mm-dd_hhmm") & ".docx"
    
    'Word-Datei als PDF abspeichern
    wdDoc.ExportAsFixedFormat ThisWorkbook.Path & "\Anforderungen_Materialzugang_" & Tabelle1.Range("B6").Value & "_" & Format(Now, "yyyy-mm-dd_hhmm") & ".pdf", wdExportFormatPDF
    
    'Word-Datei schließen
    wdDoc.Close SaveChanges:=False
    
    'Word-Applikation schließen
    wdApp.Quit

End Sub

 

Hallo,

ich nehme an, die Lösung des Problems liegt an dieser Code-Stelle:

Code:

'........
    Dim lnCol As Long, lnRow As Long
  
    'Daten aus Device Tabelle in Word einfügen
    For lnCol = 1 To UBound(Device, 2)
      lnRow = 1
      For Each wdCell In wdDoc.Tables(3).Columns(lnCol).Cells
          wdCell.Range.Text = Device(lnRow, lnCol)
          lnRow = lnRow + 1
      Next wdCell
    Next lnCol
'.........

und ich nehme an, dass es eine 2. Problemzone gibt (nur 1 Backslash zw.Pfad und Dateiname):
'Word-Datei abspeichern
wdDoc.SaveAs2 ThisWorkbook.Path & "\Anforderungen_Materialzugang_" & Tabelle1.Range("B6").Value & "_" & Format(Now, "yyyy-mm-dd_hhmm") & ".docx"

 

Herzlichen Dank für deinen Vorschlag. Gelöst habe ich es zwischenzeitlich wie folgt:

Code:

'Excel: Maschinenfreischaltung Daten sammeln
    With Tabelle1
        tblData1 = .Range("B18:F20")
    End With
 
    'Word: Tabelle Maschinenfreischaltung mit Daten füllen
    For j = 1 To 5
    i = 0

    For Each wdCell In wdDoc.Tables(3).Columns(j).Cells
        i = i + 1
        wdCell.Range.Text = tblData1(i, j)
        Next wdCell
    Next j

Kurioserweise benötige ich hier tatsächlich "\\", da das Word-Dokument mit "\" ansonsten eine Ebene darüber gespeichert wird.