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
| Sub TrfTableToXL()
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
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1)
Set oTbl = ActiveDocument.Tables(1)
For intR = 1 To oTbl.Rows.Count
For intC = 1 To oTbl.Columns.Count
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
NetText = Left(stIn, Len(stIn) - 2)
End Function |
Partager