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 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
| 'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
Sub testesimple64()
Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF, listPRnst, MESTH, docTemp
listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
Set dicoseb = CreateObject("Scripting.Dictionary")
Set dicopat = CreateObject("Scripting.Dictionary")
Set docTemp = CreateObject("htmlfile")
url = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
Set ie = CreateObject("internetexplorer.application")
With ie:
.navigate url
'IE.Visible = True:
Do: DoEvents: Loop While .readystate <> 4 Or .busy
codehtml = .document.body.innerhtml
'on crée une table avec les source choisie
Set mestr = .document.getelementsbytagname("tr")
For i = 0 To mestr.Length - 1
For p = 0 To UBound(listPRnst)
If InStr(mestr(i).innertext, listPRnst(p)) > 0 Then codetable = codetable & mestr(i).outerhtml
Next
Next
codetable = "<table ID=tableref>" & codetable & "</table>"
'on créé une table avec la synthese
ligneplace = "<TR bgcolor=""#BDBDBD"" id=Places><TH>Places</TH>"
lignecheval = "<TR bgcolor=""#BDBDBD"" id=cheval><TH>Cheval</TH>"
For i = 1 To 17
ligneplace = ligneplace & "<TH>" & i & "</TH>"
lignecheval = lignecheval & "<TH>" & i & "</TH>"
Next
ligneplace = ligneplace & "</TR>"
lignecheval = lignecheval & "</TR>"
For i = 0 To mestr.Length - 1
If InStr(mestr(i).innertext, "Synthèse") > 0 Then
For Each elem In mestr(i).Children: elem.innerhtml = elem.innertext: Next
mestr(i).ID = "synthW"
codesynth = ligneplace & mestr(i).outerhtml & "<TR></TR>" & lignecheval
End If
Next
'on prepare la lignes des syntheses pat et seb
suitesynth = suitesynth & "<tr id=fois><th> X fois cité</th>" & Application.Rept("<th>0</th>", 17) & vbCrLf
suitesynth = suitesynth & "<tr id=synthS><th> synthese sebphyto</th>" & Application.Rept("<th></th>", 17) & vbCrLf
suitesynth = suitesynth & "<tr id=synthP><th> synthese patrick</th>" & Application.Rept("<th></th>", 17) & vbCrLf
codesynth = "<table>" & codesynth & suitesynth & "</table>"
'on supprime le script 3 et on récupère le debut
lscript = Split(codehtml, "<script")
codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
docTemp.body.innerhtml = codehtml
DEBUT = Split(Split(docTemp.body.innerhtml, "Résultat")(1), "<TABLE")(0)
docTemp.body.innerhtml = DEBUT
textedebut = "": textedebut = Replace(Replace(docTemp.body.innertext, " - ", "-"), vbCrLf, " ")
Set docTemp = Nothing
.Quit
End With
'model seb
'textedebut = "QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 18:46:41]-Course 4590 PRONOSTICS PRESSE HIPPIQUE POUR LE QUINTE PMU: Prix DU BOIS BRANDIN-16 partants à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info "
'model pat
'textedebut =QUINTE Arrivée du QUINTE PMU d'aujourd'hui Lundi 27 Juillet 2015: 14-5-9/11-7 27/07/2015 [Il est 17:42:03]-Course 4590 QUINTE: Prix DU BOIS BRANDIN à CHANTILLY Mardi le 28-07-2015, Réunion 1 Course 3 Départ: 13h50 (allocation: 60000) Plat PRONOSTICS DE LA PRESSE (Revue de Presse) de pronostics-turf.info
' date de la precedente course
oldate = Split(Split(Replace(textedebut, "hui", "hier"), "hier ")(1), ":")(0)
daystring = Split(oldate, " ")(0)
oldate = Format(Split(oldate, daystring)(1), "dd/mm/yyyy")
newdate = Format(Split(Split(textedebut, " le ")(1), ",")(0), "dd/mm/yyyy")
oldarrivée = Replace(Split(Split(textedebut, ": ")(1), " ")(0), "/", "-")
nomprix = "Prix" & Split(Split(textedebut, "Prix")(1), "à")(0)
If InStr(nomprix, "partants") > 0 Then
nomprix = Split(nomprix, "-")(0)
nbpartant = Replace(Split(Split(textedebut, "partants")(0), nomprix)(1), "-", "")
End If
HiPPo = Split(Split(textedebut, "à ")(1), " ")(0)
RC = "R" & Replace(Split(Split(textedebut, "Réunion ")(1), " Départ")(0), " Course ", "C")
DsP = Split(Split(textedebut, ") ")(1), " PRONOSTICS")(0)
codedebut = codedebut & "<a>" & " date de la course precedente : " & oldate & "</a><br>"
codedebut = codedebut & "<a>" & " arrivée de la course precedente : " & oldarrivée & "</a><br>"
codedebut = codedebut & "<a>" & " date de la nouvelle course : " & newdate & "</a><br>"
codedebut = codedebut & "<a>" & " Hippodrome de la nouvelle course : " & HiPPo & "</a><br>"
codedebut = codedebut & "<a>" & " prix de la nouvelle course : " & nomprix & "</a><br>"
codedebut = codedebut & "<a>" & " Réunion et course de la nouvelle course : " & RC & "</a><br>"
codedebut = codedebut & "<a>" & " discipline de la nouvelle course : " & DsP & "</a><br>"
codedebut = codedebut & "<a>" & " nombre de partant de la nouvelle course : " & nbpartant & "</a><br>"
With CreateObject("htmlfile")
.body.innerhtml = textedebut & "<br>" & codedebut & codetable & "<br>" & codesynth
'************************************************************************************
'nombre de fois cité dans les sources choisies
Set mesthref = .getelementbyid("tableref").getelementsbytagname("TH")
Set fois = .getelementbyid("fois")
For i = 1 To 17
For A = 0 To mesthref.Length - 1
If Val(mesthref(A).innertext) = i Then fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1
Next
Next
'***************************************************************************
'syntheze patric avec les sources choisies par points
Set mesTRREF = .getelementbyid("tableref").getelementsbytagname("TR")
Set synthP = .getelementbyid("synthP")
For i = 0 To mesTRREF.Length - 1
For z = 1 To mesTRREF(i).Children.Length - 1
dicopat(mesTRREF(i).Children(z).innertext) = dicopat(mesTRREF(i).Children(z).innertext) + (8 - (z - 1))
Next
Next
Do
num = num + 1: old = 0
For Each elem In dicopat
If dicopat(elem) > old Then old = dicopat(elem): items = elem
Next
'MsgBox items & " : " & dicopat(items)
dicopat(items) = 0
synthP.Children(num).innertext = items
Loop Until num = dicopat.Count
'****************************************************************************
Set synthS = .getelementbyid("synthS")
Set synthW = .getelementbyid("synthW")
Set mesthref = .getelementbyid("tableref").getelementsbytagname("TH")
' remplissage des chevauc de la ligne syntheze par point dans le dicoseb
For i = 1 To synthW.Children.Length - 1
If synthW.Children(i).innertext <> "" Then dicoseb(Val(synthW.Children(i).innertext)) = ""
Next
'remplissage des point dans le dicoseb par raport au nombre de fois cité dans la table de source choisies
For z = 0 To mesthref.Length - 1
If dicoseb.exists(Val(mesthref(z).innertext)) Then dicoseb(Val(mesthref(z).innertext)) = Val(dicoseb(Val(mesthref(z).innertext))) + 1
Next
'retranscription dans le meme ordre que la ligne syntheze par point dans la ligne syntheze sebphyto
z = 0
For lMax = 5 To 0 Step -1
For i = 1 To synthW.Children.Length - 1
If Val(dicoseb(Val(synthW.Children(i).innertext))) = lMax Then z = z + 1: synthS.Children(z).innertext = synthW.Children(i).innertext
Next
Next
'************************************************************************************
code = .body.innerhtml
'If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
' Application.ScreenUpdating = False
' With Sheets(1)
' .Activate
'.Cells.Clear
'.Columns("A:A").ColumnWidth = 17
'.Columns("B:R").ColumnWidth = 6
' Cells(2, 1).Select
'.Paste
' End With
' .parentWindow.clipboardData.clearData "Text"
'End If
End With
'http://www.geny.com/partants-pmu/2015-07-28-chantilly-pmu-prix-du-bois-brandin
url = LCase("http://www.geny.com/partants-pmu/" & Format(newdate, "yyyy-mm-dd") & "-" & HiPPo & "-pmu-" & Replace(Trim(nomprix), " ", "-"))
Debug.Print url
musiquegeny url, code
End Sub
Sub musiquegeny(url, code)
Set ReQ = CreateObject("microsoft.xmlhttp")
ligmusiquegeny = "<tr ID=Mgeny><th> musique geny</th>"
ligpointgeny = "<tr ID=Pgeny><th>musique en chiffre </th>"
ligchev = "<tr bgcolor=""#BDBDBD""><th> cheval</th>"
confiance = "<tr bgcolor=""#BDBDBD""><th> Confiance</th>"
ReQ.Open "POST", url, False
ReQ.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
ReQ.send
With CreateObject("htmlfile")
.write ReQ.responsetext
'MsgBox .body.innertext
Set matable = .getelementbyid("dt_partants")
Set mestr = matable.getelementsbytagname("tr")
For c = 0 To mestr(0).Children.Length - 1
If mestr(i).Children(c).innertext = "Musique" Then ind = c + 3
Next
numchev = mestr.Length
For i = 1 To mestr.Length - 1
ligchev = ligchev & "<th>" & i & "</th>"
musique = ""
musique = Replace(Replace(mestr(i).Children(ind).innertext, asup, ""), "()", "")
musique = Replace(Replace(Replace(Replace(Replace(mestr(i).Children(ind).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"
div = Split(musique, "+")
resultat = 0
For pt = 0 To UBound(div): resultat = resultat + Val(div(pt)): Next
resultat = resultat / UBound(div)
ligpointgeny = ligpointgeny & "<th>" & musique & "</th>"
ligmusiquegeny = ligmusiquegeny & "<th>" & mestr(i).Children(ind).innertext & "</th>"
confiance = confiance & "<th>" & resultat & "</th>"
Next
ligpointgeny = ligpointgeny & "</tr>"
ligmusiquegeny = ligmusiquegeny & "</tr>"
ligchev = ligchev & "</tr>"
confiance = confiance & "</tr>"
titre = "<tr><th colspan=" & numchev & ">Bilan de Geny course</th></tr>"
.body.innerhtml = code & "<br>" & "<table id=geny>" & titre & ligchev & ligpointgeny & ligmusiquegeny & confiance & "</table>"
.getelementbyid("geny").Style.Border = "2px solid " & "#088A08"
If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
Application.ScreenUpdating = False
With Sheets(1)
.Activate
.Cells.Clear
.Columns("A:A").ColumnWidth = 17
.Columns("B:R").ColumnWidth = 10
Cells(2, 1).Select
.Paste
End With
.parentWindow.clipboardData.clearData "Text"
End If
End With
End Sub |
Partager