Macro per esportare tabelle MS Word in fogli Excel

Ho un documento di parole con molte tabelle. Qualcuno sa come scrivere una macro per esportare tali tabelle su fogli Excel diversi?

Risposta tratta da: http://www.mrexcel.com/forum/showthread.php?t=36875

Ecco un codice che legge una tabella da Word nel foglio di lavoro attivo di Excel. Richiede la parola documento e il numero della tabella se Word contiene più di una tabella.

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 

Questa macro deve essere inserita in Excel (non in Word) e inserita in un modulo macro standard piuttosto che nei moduli del codice evento del foglio di lavoro o della cartella di lavoro. Per fare ciò, vai al VBA (tastiera Alt-TMV), inserisci un modulo macro (Alt-IM) e incolla il codice nel pannello del codice. Esegui la macro dall’interfaccia di Excel come faresti con qualsiasi altra (Alt-TMM).

Se il tuo documento contiene molte tabelle, come sarebbe il caso se la tua tabella di 100+ pagine fosse in realtà una tabella separata su ogni pagina, questo codice potrebbe facilmente essere modificato per leggere tutte le tabelle. Ma per ora spero che sia tutto un tavolo continuo e non richiederà alcuna modifica.


Continua ad eccellere.

Damon

VBAexpert Excel Consulting (La mia altra vita: http://damonostrander.com )

Lo adoro, questo è assolutamente geniale, Damon (anche se mi ci è voluto più di un anno per trovarlo …). Ecco il mio codice finale con un’aggiunta per scorrere tutti i tavoli (a partire dalla tabella scelta):

 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 

Il prossimo trucco: capire come estrarre una tabella in una tabella da Word … e lo voglio davvero?

TC

Questa sezione di codice è quella che scorre in ogni tabella e la copia per eccellere. Forse potresti creare un object del foglio di lavoro che aggiorna dynamicmente il foglio di lavoro a cui ti stai riferendo usando il numero della tabella come contatore.

 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 

Grazie mille Damon e @ Tim

L’ho modificato per aprire i file docx, spostato un foglio di lavoro in chiaro dopo aver controllato la fuga per utente.

Ecco il codice finale:

 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