una - macro para guardar varias hojas de excel en pdf

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

Esta sección de código es la que recorre cada tabla y la copia para sobresalir. 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 2

Me encanta, esto es absolutamente genial, Damon (incluso si me llevó más de un año encontrarlo ...). Aquí está mi código final con una adición al ciclo de todas las tablas (comenzando desde 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: averiguar cómo extraer una tabla dentro de una tabla desde Word ... ¿y realmente quiero hacerlo?

TC

Answer 3

Respuesta tomada 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 cálculo 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 debe insertarse en Excel (no en Word) y colocarse en un módulo de macro estándar en lugar de en los módulos de código de evento de la hoja de trabajo o del 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.

Sigue sobresaliendo

Damon

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

Answer 4

Muchas gracias Damon y @Tim

Lo modifiqué para abrir archivos docx, moví una línea clara de la hoja de trabajo después de verificar si el usuario escapaba.

Aquí está 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