1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Sub TrfTableToXL()
'Déclaration des variables
Dim oTbl As Word.Table
Dim intR As Integer, intC As Integer
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
'Affectation des objets
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1)
Set oTbl = ActiveDocument.Tables(1)
'Boucle sur les cellules de la tables
For intR = 1 To oTbl.Rows.Count
For intC = 1 To oTbl.Columns.Count
'Copie des données cellule pour cellule
xlWs.Cells(intR, intC) = NetText(oTbl.Cell(intR, intC).Range.Text)
Next intC
Next intR
Set oTbl = Nothing
xlApp.Visible = True
End Sub
Function NetText(stIn As String) As String
'Fonction de nettoyage
'Une cellule Word comporte 2 caractères qui doivent
'être nettoyé et cette fonction le fait
NetText = Left(stIn, Len(stIn) - 2)
End Function |
Partager