Daten aus Winword importieren

Ich mußte oft Tabellen aus Winword in ein Excel Tabellenblatt einfügen. Bei einfachen Tabellen geht das problemlos mit Copy und Paste. Sobald sich jedoch ein Zeilenumbruch in einer Zelle der Word Tabelle befindet teilt Excel beim Einfügen diese Zelle in zwei oder mehrere Excel Zellen (je nach Anzahl der Umbrüche). Man muß dann mühsam die Tabelle korrigieren. Bei längeren Tabellen wird es schnell aufwändig, Mit vba lassen sich solche Tabellen sehr einfach in ein Excel Tabellenblatt einfügen.

Beispiel Code für late binding. Bei diesem Code muss man die laufende Nummer der Tabelle im Word Dokument ermitteln.

Sub Word_Tabelle_kopieren_late_binding()
Dim wrdApplication As Object, wrdDocument As Object
Dim iNoOfColumns As Integer, iNoOfRows As Integer, iRow As Integer, iCol As Integer, iTabellenNummer As Integer
Dim sZellInhalt As String
Dim ws As Worksheet
Set ws = Worksheets("Tabelle1")

' Eine neue Wordinstanz wird mit CreateObject erzeugt
Set wrdApplication = CreateObject("Word.Application")

' Word-Dokument im angegebenen Verzeichnis öffnen:
Set wrdDocument = wrdApplication.Documents.Open("E:\Dokumente\Excel Neu\vba\Word\Word Tabellen_2023_02_04.docx")
iTabellenNummer = 1
'
wrdDocument.Tables(iTabellenNummer).Select
iNoOfRows = wrdDocument.Tables(iTabellenNummer).Rows.Count
iNoOfColumns = wrdDocument.Tables(iTabellenNummer).Columns.Count
'
' Zelleninhalte aus Word-Tabellenzellen in Excel-Zellen kopieren
For iRow = 1 To iNoOfRows
    Debug.Print iRow
    For iCol = 1 To iNoOfColumns
        sZellInhalt = wrdDocument.Tables(iTabellenNummer).Cell(iRow, iCol).Range.Text
        ' In Word enthält eine Zelle die beiden Zeichen Chr(13) & Chr(7) als Zellen- oder Zeilenende-Markierung.
        ' In Word erscheint diese Markierung als "¤". Beim Kopieren des Zellinhalts in eine Excel-Zelle muss diese Markierung entfernt werden.
        sZellInhalt = Replace(sZellInhalt, Chr(13) & Chr(7), "")
        ' Abschließendes Leerzeichen entfernen
        sZellInhalt = RTrim(sZellInhalt)
        ws.Cells(iRow, iCol).Value = sZellInhalt
    Next iCol
Next iRow
 
' Word Dokument schließen und nicht speichern:
wrdDocument.Close SaveChanges:=0
'
' Word Application verlassen:
wrdApplication.Quit
'
Set wrdApplication = Nothing
Set wrdDocument = Nothing
Set ws = Nothing
End Sub

Dasselbe Beispiel mit Early Binding. Beim Early Binding muss in Excel VBA ein Verweis auf Word gesetzt werden

Sub Word_Tabelle_kopieren_early_binding()
Dim wrdApplication As Word.Application
Dim wrdDocument As Word.Document
Dim iNoOfColumns As Integer, iNoOfRows As Integer, iRow As Integer, iCol As Integer, iTabellenNummer As Integer
Dim sCellContent As String
Dim ws As Worksheet
Set ws = Worksheets("Tabelle1")

' Eine neue Wordinstanz wird mit CreateObject erzeugt
Set wrdApplication = CreateObject("Word.Application")

' Word-Dokument im angegebenen Verzeichnis öffnen:
Set wrdDocument = wrdApplication.Documents.Open("E:\Dokumente\Excel Neu\vba\Word\Word Tabellen_2023_02_04.docx")
iTabellenNummer = 1
'
wrdDocument.Tables(iTabellenNummer).Select
iNoOfRows = wrdDocument.Tables(iTabellenNummer).Rows.Count
iNoOfColumns = wrdDocument.Tables(iTabellenNummer).Columns.Count
'
' Zelleninhalte aus Word-Tabellenzellen in Excel-Zellen kopieren
For iRow = 1 To iNoOfRows
    Debug.Print iRow
    For iCol = 1 To iNoOfColumns
        sCellContent = wrdDocument.Tables(iTabellenNummer).Cell(iRow, iCol).Range.Text
        ' In Word enthält eine Zelle die beiden Zeichen Chr(13) & Chr(7) als Zellen- oder Zeilenende-Markierung.
        ' In Word erscheint diese Markierung als "¤". Beim Kopieren des Zellinhalts in eine Excel-Zelle muss diese Markierung entfernt werden.
        sCellContent = Replace(sCellContent, Chr(13) & Chr(7), "")
        ' Abschließendes Leerzeichen entfernen
        sCellContent = RTrim(sCellContent)
        ws.Cells(iRow, iCol).Value = sCellContent
    Next iCol
Next iRow
 
' Word Dokument schließen und nicht speichern:
wrdDocument.Close SaveChanges:=0
'
' Word Application verlassen:
wrdApplication.Quit
'
Set wrdApplication = Nothing
Set wrdDocument = Nothing
Set ws = Nothing
End Sub

Falls ein Word Dokument viele Tabellen enthält kann man folgendes Word VBA Makro verwenden, um die Nummer einer selektierten Tabelle zu ermitteln.

Sub TabellenNummer()
Dim lTabelleGefunden As Boolean
Dim CurrentSelection As Long, T_Start As Long, T_Ende As Long
Dim oTabelle As Table, j As Long
CurrentSelection = Selection.Range.Start
lTabelleGefunden = False
For Each oTabelle In ActiveDocument.Tables
    T_Start = oTabelle.Range.Start
    T_Ende = oTabelle.Range.End
    j = j + 1
    If CurrentSelection >= T_Start And CurrentSelection <= T_Ende Then
       lTabelleGefunden = True
       Debug.Print "Tabellennummer: " & j
       Exit For
    End If
Next
If lTabelleGefunden = False Then
   Debug.Print "Keine Tabelle selektiert"
End If
End Sub

Daten aus Winword importieren

Related Posts:

Schreibe einen Kommentar Antworten abbrechen