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
| Option Explicit
Sub testX()
Dim p, I&
Sheets(1).Cells.Clear
p = Array("Pilier", "Talonneur", "2%E8me%20ligne", "3%E8me%20ligne", "Demi%20de%20m%EAl%E9e", "Ouvreur", "Ailier", "Centre", "Arri%E8re", "all")
For I = 0 To UBound(p)
getTable p(I), 1, 40
Next
End Sub
Sub getTable(place, debut, fin)
Application.ScreenUpdating = False
Dim Req As Object, url As String, Tables, T, elem
'http://www.rugbycoaching.eu/joueurs.php?poste=" & Tab_Place(place) & "&club=all&journee=all&tri=points&from=" & debut & "&to=" & fin
url = "http://www.rugbycoaching.eu/joueurs.php?poste=" & place & "&club=all&journee=all&tri=points&from=1&to=40"
Set Req = CreateObject("microsoft.xmlhttp")
Req.Open "GET", url, False
Req.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
Req.send
With CreateObject("htmlfile")
.body.innerhtml = Req.responsetext
Set Tables = .getelementsbytagname("TABLE")
Set T = Tables(5)
For Each elem In T.all
If elem.tagname = "IMG" Then elem.parentelement.RemoveChild (elem)
Next
If .parentWindow.clipboardData.setData("Text", "<html><body><font color=#ff0000 size=6><strong>" & place & "</strong></font><br>" & T.outerhtml & "</body></html>") Then
Application.ScreenUpdating = False
With Sheets(1)
.Activate
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
.Paste
End With
.parentWindow.clipboardData.clearData "Text"
End If
End With
End Sub |
Partager