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 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
| Option Explicit
Dim tablo
Const linkhyppo = "http://www.zeturf.fr/fr/programmes-et-pronostics/reunion?id="
Const linkcourse = "http://www.zeturf.fr/fr/programmes-et-pronostics/course?id="
Sub que_ce_passe_t_il_maintenant_chez_zeturf()
zeturf "aujourd'hui" 'pour les pronos jour meme
End Sub
Sub que_ce_passe_t_il_demain_chez_zeturf()
zeturf "demain" 'pour les pronos de demain
End Sub
Sub que_ce_passe_t_il_apres_demain_chez_zeturf()
zeturf "apres demain" 'pour les pronos apres demain
End Sub
Sub zeturf(zeturfday)
Dim url As String, code As String, elem As Object, i As Long, mestr As Object, tabb
'supprime tableau
Sheets("Temp").Range("A2:N20").ClearContents
Select Case zeturfday
Case "aujourd'hui": tabb = 1
Case "demain": tabb = 2
Case "apres demain": tabb = 3
End Select
url = "http://www.zeturf.fr/fr/programmes-et-pronostics"
code = recupe_html(url)
With CreateObject("htmlfile")
.body.innerHTML = code
For Each elem In .all
If elem.ID = "box_day" Then i = i + 1
If i = tabb Then code = elem.outerhtml: Exit For
Next
.body.innerHTML = code
Set mestr = .getelementsbytagname("TR")
ReDim tablo(mestr.Length, 30)
For i = 0 To 3 'mestr.Length - 1 que les 4 1ère réunions
tablo(i, 0) = "R" & i + 1
tablo(i, 1) = mestr(i).Children(3).innertext
tablo(i, 2) = Split(Split(mestr(i).Children(3).Children(0).href, "id=")(1), Chr(34))(0)
Next
End With
Sheets("Temp").Cells(2, 1).Resize(UBound(tablo), 30) = tablo
et_que_ce_passe_t_il_sur_ces_hyppodrome
End Sub
Public Function recupe_html(url)
Dim REQ
Set REQ = CreateObject("microsoft.xmlhttp")
REQ.Open "POST", url, False
REQ.send
recupe_html = REQ.responseText
End Function
Function et_que_ce_passe_t_il_sur_ces_hyppodrome()
Dim Cse As Long, i As Long, mestr As Object, table As Object, code As String
Application.ScreenUpdating = False
For i = 0 To 3 'UBound(tablo) - 1 '------ 4 réunions seulement
code = recupe_html(linkhyppo & tablo(i, 2))
With CreateObject("htmlfile")
.body.innerHTML = code
'Debug.Print code
Set table = .getelementbyid("box_meeting").getelementsbytagname("TABLE")(0)
Set mestr = table.getelementsbytagname("TR")
ReDim Preserve tablo(0 To 6, 0 To mestr.Length + 2)
For Cse = 1 To mestr.Length - 1
tablo(i, 2 + Cse) = mestr(Cse).Children(1).innertext
tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(3).innertext 'prix
tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(5).innertext 'nb partant
tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(6).innertext 'heure dep
tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & Split(Split(mestr(Cse).Children(3).Children(0).href, "id=")(1), Chr(34))(0) 'id courses
Pour_chaque_courses i, Cse
Next
End With
Next
Sheets("Temp").Cells(2, 1).Resize(UBound(tablo), Cse + 3) = tablo
Application.ScreenUpdating = True
End Function
Function Pour_chaque_courses(i, Cse)
Dim cpt As Integer, nbp As Integer, nb As Integer, Dlig As Integer
Dim IdCours 'As Long
Dim part As Object, cote As Object
Dim url, codecote As String
Dim tablo_cote()
IdCours = Split(tablo(i, 2 + Cse), vbCrLf)(4)
url = "http://www.zeturf.fr/fr/les-cotes-zeturf/course?id=" & IdCours
'url = "http://www.zeturf.fr/fr/les-cotes-zeturf/course?id=171644"
codecote = recupe_html(url)
With CreateObject("htmlfile")
'.write recupe_html(url)
.body.innerHTML = codecote
Set cote = .getelementsbytagname("table")
For nb = 0 To cote.Length - 1
If cote(nb).classname = ("excel") Then
Set part = cote(nb).Rows
ReDim Preserve tablo_cote(0 To part.Length - 1)
For nbp = 2 To part.Length - 1
tablo_cote(nbp) = Trim(part(nbp).Children(0).innertext) 'num partant
tablo_cote(nbp) = tablo_cote(nbp) & Chr(32) & Trim(part(nbp).Children(1).Children(0).innertext) 'non partant
tablo_cote(nbp) = tablo_cote(nbp) & Chr(32) & Trim(part(nbp).Children(2).innertext) 'cote à une certaine heure
tablo_cote(nbp) = tablo_cote(nbp) & Chr(32) & Trim(part(nbp).Children(3).innertext) 'cote en direct
tablo_cote(nbp) = tablo_cote(nbp) & Chr(32) & Trim(part(nbp).Children(4).innertext) 'cote placé
Next nbp
tablo_cote(0) = Trim(Split(tablo(i, 2 + Cse), vbCrLf)(0))
If nbp = part.Length Then Exit For
End If
Next nb
End With
Dlig = ThisWorkbook.Worksheets("Par courses").Range("c" & Rows.Count).End(xlUp).Row + 1
With Sheets("Par courses")
.Activate
.Cells(Dlig, 1).Resize(1, UBound(tablo_cote)) = tablo_cote
.Columns("A:Z").WrapText = False
.Columns("A:Z").HorizontalAlignment = xlCenter
.Columns("A:Z").AutoFit
End With
End Function |
Partager