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
| Sub Lgeny()
Dim url, IE, Mdate, Hippo, mesTH, tablogeny
Mdate = Range("B4"): Hippo = Range("B7")
url = LCase("http://www.geny.com/partants-pmu/" & Format(Mdate, "yyyy-mm-dd") & "-" & Hippo)
Set IE = CreateObject("internetexplorer.application")
IE.navigate url
IE.Visible = True
Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy
Set matable = IE.document.getelementbyid("dt_partants")
Set mestr = matable.getelementsbytagname("tr")
Set repere = matable.getelementsbytagname("TR")(0)
For i = 1 To repere.Children.Length - 1
If repere.Children(i).innertext = "Musique" Then Index = i: Exit For
Next
ReDim tablogeny(3, Val(Range("B5")))
tablogeny(0, 0) = "cheval"
tablogeny(1, 0) = "Musique"
tablogeny(2, 0) = "calcul"
For i = 3 To mestr.Length - 1
tablogeny(0, i - 2) = i - 2
musique = ""
musique = Replace(Replace(mestr(i).Children(Index).innertext, asup, ""), "()", "")
musique = Replace(Replace(Replace(Replace(Replace(mestr(i).Children(Index).innertext, "Dpag", 11), "T", 11), "A", 11), 0, 11), "D", 11)
musique = Replace(Replace(Replace(Replace(musique, "a", "+"), "m", "+"), "p", "+"), "R", 11)
If InStr(musique, "(") > 0 Then asupp = "(" & Split(Split(musique, "(")(1), ")")(0) & ")"
musique = Replace(musique, asupp, "") & "0"
nb = Split(musique, "+")
tablogeny(1, i - 2) = musique
For d = 0 To UBound(nb): tablogeny(2, i - 2) = Val(tablogeny(2, i - 2)) + Val(nb(d)): Next
'debug.Print musique
Next
Do
old = 1000
cpt = cpt + 1
For col = 1 To Val(Range("B5"))
If tablogeny(2, col) < old Then
old = tablogeny(2, col)
chev = tablogeny(0, col)
Index = col
End If
Next
tablogeny(2, Index) = 1000
ligne1 = ligne1 & "<TH>" & chev & "</TH>"
ligne2 = ligne2 & "<TH>" & tablogeny(1, Index) & "</TH>"
ligne3 = ligne3 & "<TH>" & old & "</TH>"
Loop Until cpt = Val(Range("B5"))
codegeny = "<table><TR><TH id =titregeny colspan=" & Val(Range("B5") + 1) & ">Musique geny</TH></TR>"
codegeny = codegeny & "<TR><TH id=titreligne>Cheval</TH>" & ligne1 & "</TR>" & vbCrLf
codegeny = codegeny & "<TR><TH id=titreligne>Musique</TH>" & ligne2 & "</TR>" & vbCrLf
codegeny = codegeny & "<TR><TH id=titreligne>Calcul</TH>" & ligne3 & "</TR>" & vbCrLf & "</table>"
Debug.Print codegeny
With CreateObject("htmlfile")
.write codegeny
'titrecaption #088A08 #FFFFFF
' titreligne #04B404 #FFFFFF
For Each elem In .all
If elem.tagname = "TABLE" Then elem.Style.backgroundcolor = "#A9F5A9"
If elem.ID = "titregeny" Then elem.Style.backgroundcolor = "#088A08": elem.Style.Color = "#FFFFFF"
If elem.ID = "titreligne" Then elem.Style.backgroundcolor = "#04B404": elem.Style.Color = "#FFFFFF"
Next
If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
Application.ScreenUpdating = False
With Sheets(1)
.Activate
Cells(29, 1).Select
.Paste
End With
.parentWindow.clipboardData.clearData "Text"
End If
'Cells(29, 1).Resize(3, 20) = tablogeny
End With
IE.Quit
End Sub |
Partager