Recuperation json cotes pmu
Bonjour.Ci joint un fichier qui récupère les cotes pmu de chaque course d'une réunion.Le problème, a chaque foi que je veux changer de course,je suis obligé de visualiser le code et de changer le numéro de la course manuellement.Peut être existe t il une solution vba pour éviter ces manipulations ? Merci de vos réponses et bonne journée.
Bonjour,
mets le n° de la course en A1 par exemple
Site = "https://offline.turfinfo.api.pmu.fr/rest/client/7/programme/" & Range("A1") & "/R1/C1/participants"Merci,avec un peu de retard!Comme je n'avais pas de réponses,je ne me connectai pas.Bonne journée.
Bonjour le forum,
Je suis à la recherche d'un fichier similaire, qui importe les cotes pmu de chaque course d'une réunion, malheureusement celui ci est statique , il faudrait pouvoir lui indiquer la Réunion souhaitée ( R1, R2, R3 etc ... ) et que pour chaque course, un onglet soit créé automatiquement , afin d'y importer la course concernée ( onglet C1 pour la 1 ère course, C2 pour la 2 ème etc ... ), et ce, jusqu'à 9 courses maxi . avec les mêmes renseignements décrits ci dessous.
Je sais pas si c'est possible.
Cordialement;
Mamarus
Bonjour,
Quel site utilises-tu d'habitude ?
Bon, j'ai cherché un peu de mon côté
Je vais tester ceci https://offline.turfinfo.api.pmu.fr/rest/client/7/programme/04082020/R3/
et ceci https://offline.turfinfo.api.pmu.fr/rest/client/7/programme/04082020/R3/C4/ par exemple en mettant la date et la réunion en paramètre et en faisant varier la course.
Pas simple !
Il faut que je mixe les 2 !
Bonjour Steelson,
Merci pour t'être interessé à ce sujet,
Le site ci dessus ou les cotes ont été importés se rapprochent le + par rapport à ceux du PMU, celui ci faisant reference de bible en la matière.
Pour cela il faudrait, dans une variable, le N° de la réunion et importer chaque course de celle ci dans son onglet respectif.
Ma demande ne concerne qu'une seule Réunion à demander à chaque fois, Pour cela:
* on recupere pour chaque course le tableau des partants avec pour chacun, leurs cotes respectifs, comme dans le modèle proposé + haut, mais serait il possible de rajouter dans la colonne d'aprés, pour chaque N°, le montant joué pour ce cheval .
en Ex: sur la R1 C1 d'aujourd'hui, le montant joué du N° 8 est de 3704 €, on trouve cette information sur le site PMU à la rubrique " les + joués ", mais là, j'avoue que je ne sais ou trop aller chercher ces infos là.
je pense fonctionner à lancer une Réunion après l'autre manuellement, mais si on peut l'automatiser ce serait top.
Cordialement;
Mamarus
Sub Turf()
Dim f As Worksheet
Dim ScriptControl As Object, PMU As Object, prog As Object, reu As Object, r As Object, hippo As Object
Dim Site As String, i As Long
suppfeuilles
Range("A1").CurrentRegion.Offset(2, 0).ClearContents
Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
ScriptControl.Language = "JScript"
Site = Range("C1").Value
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Site, False
.send
Set PMU = ScriptControl.Eval("(" + .responseText + ")")
.abort
End With
i = 3
Set prog = PMU.programme
Set reu = prog.reunions
'On Error Resume Next
For Each r In reu
With ActiveSheet
.Cells(i, 1).Value = "R" & r.numOfficiel
Set hippo = r.hippodrome
.Cells(i, 2).Value = hippo.libelleCourt
i = i + 1
End With
Next r
Set PMU = Nothing
Set ScriptControl = Nothing
End Sub
Sub Turf2()
Dim ScriptControl As Object, PMU As Object, cou As Object, c As Object
Dim Site As String, i As Long
suppfeuilles
Range("A1").CurrentRegion.Offset(2, 2).ClearContents
If Not Cells(Selection.Row, 1) Like "R*" Then
MsgBox "Sélectionner eune réunion !"
Exit Sub
End If
Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
ScriptControl.Language = "JScript"
Site = Range("C1").Value & Cells(Selection.Row, 1) & "/"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Site, False
.send
Set PMU = ScriptControl.Eval("(" + .responseText + ")")
.abort
End With
i = Selection.Row
ActiveSheet.Cells(Selection.Row, 3) = ">>>"
Set cou = PMU.courses
'On Error Resume Next
For Each c In cou
With ActiveSheet
.Cells(i, 4).Value = .Cells(Selection.Row, 1) & "/C" & c.numOrdre
.Cells(i, 5).Value = c.libelle
i = i + 1
End With
Next c
Set PMU = Nothing
Set ScriptControl = Nothing
Turf3
End Sub
Sub Turf3()
Dim f As Worksheet, newf As Worksheet
Dim ScriptControl As Object, PMU As Object
Dim Ecurie As Object, Cheval As Object, Drd As Object, Gp As Object
Dim Site As String, li As Long
Set f = ActiveSheet
reunion = f.Range("B" & Selection.Row)
For i = Selection.Row To f.Range("D" & Rows.Count).End(xlUp).Row
RC = f.Range("D" & i)
Set newf = Sheets.Add(After:=Sheets(Sheets.Count))
newf.Name = Replace(RC, "/", " ")
Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
ScriptControl.Language = "JScript"
Site = f.Range("C1").Value & RC & "/participants"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Site, False
.send
Set PMU = ScriptControl.Eval("(" + .responseText + ")")
.abort
End With
li = 2
newf.Cells(1, 1) = f.Range("B1")
newf.Cells(1, 1).NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
newf.Cells(1, 2) = "Cheval"
newf.Cells(1, 3) = "Cote"
newf.Cells(1, 4) = reunion
newf.Cells(1, 5) = f.Range("E" & i)
Set Ecurie = PMU.participants
On Error Resume Next
For Each Cheval In Ecurie
With ActiveSheet
newf.Cells(li, 1).Value = Cheval.numPmu
newf.Cells(li, 2).Value = Cheval.nom
Set Drd = Cheval.dernierRapportDirect
newf.Cells(li, 3).Value = Drd.rapport
li = li + 1
End With
Next Cheval
newf.Cells.EntireColumn.AutoFit
Set PMU = Nothing
Set ScriptControl = Nothing
Next
f.Select
End Sub
Sub suppfeuilles()
Dim f As Worksheet
For Each f In Worksheets
Application.DisplayAlerts = False
If f.Name <> ActiveSheet.Name Then f.Delete
Application.DisplayAlerts = True
Next
End SubVoici les seules infos que j'ai sur le num 8 à cette heure-ci.
Peut-être qu'avant la course il y a la donnée que tu souhaites ... sinon je ne suis pas turfiste et donc ne pourrai pas la trouver par moi-même.
bonsoir Steelson,
La dernière demande, j'ai bien conscience que c'est pas évident à la trouver, c'était la cerise sur le gâteau, mais je t'ai tellement demande .
Je ne vais pas en abuser.
je testerai le code demain
Merci encore à toi et bonne soirée.
Cordialement,
Mamarus
Bonjour Steelson,
j'ai testé le code, le système plante lors de la recherche de Réunion avec cette ligne de code suivante :
Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
Par ailleurs, serait il possible de récupérer la musique de chaque cheval en le mettant après la cellule de la cote, cette info on la retrouve dans l'exemple que tu m'as envoyé hier concernant l'exemple du N° 8 cellule D513 voici à quoi cela ressemble ==> 4h2h5h0h1s9h(19)0h3s6h
Merci,
Cordialement;
Mamarus
j'ai testé le code, le système plante lors de la recherche de Réunion avec cette ligne de code suivante :
Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
Avec le fichier que j'ai posté ? ou tu as recopié le code dans un autre fichier ?
Je viens d'essayer, c'est nickel !
Bonjour Steelson,
Avec le fichier posté, j'utilise Excel 2016 !
Cordialement;
Mamarus
Je viens d'essayer avec un autre ordinateur qui a excel 2016 : aucun plantage.
Fais une copie d'écran de l'éditeur de macro après avoir cliqué sur outils > références comme ici
avec la musique (c'est quoi au juste ?)
voici l'imprim'Ecran demandé
Mamarus
Pas d'anomalie a priori ... donc je ne vois pas comment résoudre le problème car chez moi cela fonctionne avec xl2016 !
Bonjour Steelson,
Je vais tenter de l'enregistrer sous le format d'excel 2007, je verrai bien ce que cela donne
As tu le temps de rajouter la musique ( 4h 2 p 6 p ...... ). Dans la cellule apres la cote ?
Merci
Mamarus