Macro para exportar tablas de MS Word a hojas de Excel

Question

Tengo un documento de Word con muchas tablas. ¿Alguien sabe cómo escribir una macro para exportar tales tablas a diferentes hojas de Excel?

Answer 1

respuesta tomado de: http://www.mrexcel.com/forum/showthread.php?t=36875

Aquí hay un código que lee una tabla de Word en la hoja de trabajo activa de Excel. Le solicita el documento de Word y el número de tabla si Word contiene más de una tabla.

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 

Esta macro se debe insertar en Excel (no Word) y puesto en un módulo macro estándar en lugar de en los módulos de código evento de hoja o un libro. Para hacerlo, vaya al VBA (teclado Alt-TMV), inserte un módulo de macro (Alt-IM) y pegue el código en el panel de códigos. Ejecute la macro desde la interfaz de Excel como lo haría con cualquier otro (Alt-TMM).

Si su documento contiene muchas tablas, como sería el caso si su tabla de más de 100 páginas es en realidad una tabla separada en cada página, este código podría modificarse fácilmente para leer todas las tablas. Pero por ahora espero que sea una sola tabla continua y no requiera ninguna modificación.

---

Keep Excelling.

Damon

VBAexpert Excel Consulting (mi otra vida: http://damonostrander.com)

Answer 2

Esta sección de código es el que recorre cada mesa y lo copia en Excel. Tal vez podría crear un objeto de hoja de cálculo que actualice dinámicamente la hoja de cálculo a la que se refiere usando el número de tabla como contador.

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

Me encanta, esto es absolutamente genial, Damon (incluso si me llevó más de un año encontrar ...). Aquí está mi código final con una adición de bucle a través de todas las tablas (a partir de la tabla elegida):

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 

siguiente truco: la elaboración de cómo extraer una tabla dentro de una mesa de la Palabra ... y lo que realmente quiero ¿a?

TC

Answer 4

Gracias tanto Damon y @Tim

lo modifico para abrir archivos docx, moví una línea clara hoja de trabajo después de la comprobación de fuga por el usuario.

Aquí es el código final:

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