Makro zum Exportieren von MS Word-Tabellen in Excel-Tabellen

Question

Ich habe ein Word-Dokument mit vielen Tabellen. Kann jemand ein Makro schreiben, um solche Tabellen in verschiedene Excel-Blätter zu exportieren?

Answer 1

Antwort entnommen aus: http://www.mrexcel.com/forum/showthread.php?t=36875

Hier ist ein Code, der eine Tabelle aus Word in das aktive Arbeitsblatt von Excel liest. Es fragt Sie nach dem Word-Dokument und der Tabellennummer, wenn Word mehr als eine Tabelle enthält.

Sub ImportWordTable() 
Dim wdDoc As Object 
Dim wdFileName As Variant 
Dim TableNo As Integer 'table number in Word 
Dim iRow As Long 'row index in Excel 
Dim iCol As Integer 'column index in Excel 

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _ 
"Browse for file containing table to be imported") 

If wdFileName = False Then Exit Sub '(user cancelled import file browser) 

Set wdDoc = GetObject(wdFileName) 'open Word file 

With wdDoc 
    TableNo = wdDoc.tables.Count 
    If TableNo = 0 Then 
     MsgBox "This document contains no tables", _ 
     vbExclamation, "Import Word Table" 
    ElseIf TableNo > 1 Then 
     TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _ 
     "Enter table number of table to import", "Import Word Table", "1") 
    End If 
    With .tables(TableNo) 
     'copy cell contents from Word table cells to Excel cells 
     For iRow = 1 To .Rows.Count 
      For iCol = 1 To .Columns.Count 
       Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
      Next iCol 
     Next iRow 
    End With 
End With 

Set wdDoc = Nothing 

End Sub 

Dieses Makro sollte in Excel (nicht Word) und in einem Standard-Makro-Modul eingesetzt werden, anstatt in das Arbeitsblatt oder eine Arbeitsmappe Ereigniscode-Module. Wechseln Sie dazu zu der VBA (Tastatur Alt-TMV), fügen Sie ein Makromodul (Alt-IM) ein, und fügen Sie den Code in dem Codefenster ein. Führen Sie das Makro von der Excel-Schnittstelle wie jedes andere (Alt-TMM) aus.

Wenn Ihr Dokument viele Tabellen enthält, wie es der Fall wäre, wenn Ihre über 100-seitige Tabelle tatsächlich eine separate Tabelle auf jeder Seite ist, könnte dieser Code leicht geändert werden, um alle Tabellen zu lesen. Aber im Moment hoffe ich, dass es eine einzige kontinuierliche Tabelle ist und keine Änderung erfordert.

---

Ausgezeichnet bleiben.

Damon

VBAexpert Excel Beratung (Mein anderes Leben: http://damonostrander.com)

Answer 2

Dieser Codeabschnitt ist derjenige, der durch jede Tabelle und kopiert sie Schleifen zu übertreffen. Vielleicht könnten Sie ein Arbeitsblattobjekt erstellen, das das Arbeitsblatt, auf das Sie verweisen, dynamisch aktualisiert, indem Sie die Tabellennummer als Zähler verwenden.

With .tables(TableNo) 
'copy cell contents from Word table cells to Excel cells 
For iRow = 1 To .Rows.Count 
For iCol = 1 To .Columns.Count 
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
Next iCol 
Next iRow 
End With 
End With 

Answer 3

Liebe es, das ist absolut brillant, Damon (auch wenn ich über ein Jahr brauchte, um zu finden ...). Hier ist mein letzter Code mit einem Zusatz zu Schleife durch alle Tabellen (aus der gewählten Tabelle beginnend):

Option Explicit 

Sub ImportWordTable() 

Dim wdDoc As Object 
Dim wdFileName As Variant 
Dim tableNo As Integer 'table number in Word 
Dim iRow As Long 'row index in Excel 
Dim iCol As Integer 'column index in Excel 
Dim resultRow As Long 
Dim tableStart As Integer 
Dim tableTot As Integer 

On Error Resume Next 

ActiveSheet.Range("A:AZ").ClearContents 

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _ 
"Browse for file containing table to be imported") 

If wdFileName = False Then Exit Sub '(user cancelled import file browser) 

Set wdDoc = GetObject(wdFileName) 'open Word file 

With wdDoc 
    tableNo = wdDoc.tables.Count 
    tableTot = wdDoc.tables.Count 
    If tableNo = 0 Then 
     MsgBox "This document contains no tables", _ 
     vbExclamation, "Import Word Table" 
    ElseIf tableNo > 1 Then 
     tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _ 
     "Enter the table to start from", "Import Word Table", "1") 
    End If 

    resultRow = 4 

    For tableStart = 1 To tableTot 
     With .tables(tableStart) 
      'copy cell contents from Word table cells to Excel cells 
      For iRow = 1 To .Rows.Count 
       For iCol = 1 To .Columns.Count 
        Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
       Next iCol 
       resultRow = resultRow + 1 
      Next iRow 
     End With 
     resultRow = resultRow + 1 
    Next tableStart 
End With 

End Sub 

Next Trick: herauszufinden, wie eine Tabelle aus Word in eine Tabelle zu extrahieren ... und tut wirklich ich will zu?

TC

Answer 4

Vielen Dank Damon und @ Tim

ich es ein Arbeitsblatt klare Linie docx-Dateien, bewegt nach der Überprüfung für die Flucht durch den Benutzer zu öffnen geändert.

Hier ist der endgültige Code:

Option Explicit 

Sub ImportWordTable() 

Dim wdDoc As Object 
Dim wdFileName As Variant 
Dim tableNo As Integer  'table number in Word 
Dim iRow As Long   'row index in Excel 
Dim iCol As Integer   'column index in Excel 
Dim resultRow As Long 
Dim tableStart As Integer 
Dim tableTot As Integer 

On Error Resume Next 

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ 
"Browse for file containing table to be imported") 

If wdFileName = False Then Exit Sub '(user cancelled import file browser) 

ActiveSheet.Range("A:AZ").ClearContents 

Set wdDoc = GetObject(wdFileName) 'open Word file 

With wdDoc 
    tableNo = wdDoc.tables.Count 
    tableTot = wdDoc.tables.Count 
    If tableNo = 0 Then 
     MsgBox "This document contains no tables", _ 
     vbExclamation, "Import Word Table" 
    ElseIf tableNo > 1 Then 
     tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _ 
     "Enter the table to start from", "Import Word Table", "1") 
    End If 

    resultRow = 4 

    For tableStart = tableNo To tableTot 
     With .tables(tableStart) 
      'copy cell contents from Word table cells to Excel cells 
      For iRow = 1 To .Rows.Count 
       For iCol = 1 To .Columns.Count 
        Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
       Next iCol 
       resultRow = resultRow + 1 
      Next iRow 
     End With 
     resultRow = resultRow + 1 
    Next tableStart 
End With 

End Sub