Makro eksportować tabele MS Word na arkuszach Excel

Question

Mam dokument programu Word z wielu tabel. Czy ktoś wie, jak napisać makro do eksportu takich tabel do różnych arkuszy Excel?

Answer 1

odpowiedzi pochodzą z: http://www.mrexcel.com/forum/showthread.php?t=36875

Oto kod, który odczytuje tabelę z programu Word w aktywnym arkuszu programu Excel. Monituje o dokument słowny, a także numer tabeli, jeśli program Word zawiera więcej niż jedną tabelę.

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 

To makro należy wprowadzić do programu Excel (nie słowa) i umieścić w module standardowym makro zamiast do modułów kod zdarzenia arkusza lub skoroszytu. Aby to zrobić, przejdź do VBA (klawiatura Alt-TMV), włóż moduł makr (Alt-IM) i wklej kod do okienka kodu. Uruchom makro z interfejsu programu Excel, tak jak każdy inny (Alt-TMM).

Jeśli dokument zawiera wiele tabel, jak byłoby w przypadku, jeśli strona 100+ stół jest właściwie osobny stolik na każdej stronie, to kod może być łatwo modyfikowany, aby przeczytać wszystkie tabele. Ale na razie mam nadzieję, że jest to jedna ciągła tabela i nie będzie wymagać żadnych modyfikacji.

---

Zachowaj doskonałe wyniki.

Damon

VBAexpert Excel Consulting (Moje inne życie: http://damonostrander.com)

Answer 2

Ta część kodu jest ten, który pętle przez każdy stół i kopiuje go do programu Excel. Być może możesz utworzyć obiekt arkusza roboczego, który dynamicznie aktualizuje arkusz roboczy, do którego się odwołujesz, używając numeru stołu jako licznika.

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

Uwielbiam to miejsce, to jest absolutnie genialny, Damon (nawet jeśli zajęło mi ponad rok, aby znaleźć ...). Oto mój ostatni kod z dodatkiem pętli wszystkich tabel (począwszy od wybranej tabeli):

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 

Następny trick: wypracowanie sposobu wyodrębniania tabelę w tabeli ze Słowem ... i naprawdę chcę do?

TC

Answer 4

Dziękuję Damon i @Tim

zmodyfikowałem go otworzyć pliki docx, przeniósł arkusza jasną linię po sprawdzeniu na ucieczkę przez użytkownika.

Oto ostateczny kod:

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