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 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
| Private Sub cmd_extract_Click()
uf.Hide
Dim html As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object
Dim file As String
Dim sh As Worksheet
file = txt
TextFile = FreeFile
Open file For Input As TextFile
Set HTML_Content = CreateObject("htmlfile")
HTML_Content.body.innerHtml = Input(LOF(TextFile), TextFile)
Column_Num_To_Start = 1
iRow = 2
iCol = Column_Num_To_Start
iTable = 0
For Each Tab1 In HTML_Content.getElementsByTagName("table")
With HTML_Content.getElementsByTagName("table")(iTable)
For Each Tr In .Rows
For Each Td In Tr.Cells
Application.ScreenUpdating = False
Sheets("Feuil2").Visible = True
Set sh = ActiveWorkbook.Worksheets("Feuil2")
With sh
sh.Select
.Cells(iRow, iCol).Select
.Cells(iRow, iCol) = Td.innerText
iCol = iCol + 1
End With
Next Td
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tr
End With
iTable = iTable + 1
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tab1
Sheets("Feuil2").Visible = False
Application.ScreenUpdating = True
End Sub |
Partager