Lancer Requêtes toutes les x mins mais.

Version imprimable

Voir 40 message(s) de cette discussion en une page

14/02/2016, 20h44
patricktoulon

re

tu ne peut pas retranscrire un tableau a 3 dim sur un sheet en l'état comme ca cette question c'est réglé
le sheets ayant que des lignes et colonnes

après oui tu pourrais enregistrer le code html de toutes les pages mais ca fait beaucoup

mais ma demo c'était juste pour te montrer que récupérer juste les information utile est simple et après on va ou on veut avec ces simple 3 données pour chaque courses
14/02/2016, 20h52
Sebphyto

Citation:

tu ne peut pas retranscrire un tableau a 3 dim sur un sheet en l'état comme ca cette question c'est réglé

arrrfff, c dommage, mais bon en soit c'est pas bien grave. car les données sont dans un tablo, c'était juste pour avoir un visu sur le tableau..

Citation:

après oui tu pourrais enregistrer le code html de toutes les pages mais ca fait beaucoup

Je me doutais de ce que tu allais me dire, bon tant pis alors...çà devra attendre que j'ai plus de temps..

Citation:

mais ma demo c'était juste pour te montrer que récupérer juste les information utile est simple et après on va ou on veut avec ces simple 3 données pour chaque courses

je l'avais bien compris, et pour çà j'arrive très bien à naviguer
seb

re toute petite modif sur la demo

dans la page des hyppodromes tu a aujourd'hui,demain ,apres demain

j'ai ajouter cette fonctionnalité au cas ou tu aurais pas pu le faire la veille au soir
j'ai ajouter 6 lignes c'est pour te dire a quel point si le code est intelligent tu peut remanier comme tu veux

Code:

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
Option Explicit
Dim tablo
Const linkhyppo = "<a href="http://www.zeturf.fr/fr/programmes-et-pronostics/reunion?id" target="_blank">http://www.zeturf.fr/fr/programmes-e...ics/reunion?id</a>="
Const linkcourse = "<a href="http://www.zeturf.fr/fr/programmes-et-pronostics/course?id" target="_blank">http://www.zeturf.fr/fr/programmes-e...tics/course?id</a>="
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 = "<a href="http://www.zeturf.fr/fr/programmes-et-pronostics" target="_blank">http://www.zeturf.fr/fr/programmes-et-pronostics</a>"
    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 mestr.Length - 1
            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
    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
    For i = 0 To UBound(tablo) - 1
        code = recupe_html(linkhyppo & tablo(i, 2))
        With CreateObject("htmlfile")
            .body.innerHTML = code
            Set table = .getelementbyid("box_meeting").getelementsbytagname("TABLE")(0)
            Set mestr = table.getelementsbytagname("TR")
            For Cse = 1 To mestr.Length - 1
                tablo(i, 2 + Cse) = mestr(Cse).Children(3).innertext
                tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(5).innertext
                tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(6).innertext
                tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & Split(Split(mestr(Cse).Children(3).Children(0).href, "id=")(1), Chr(34))(0)
            Next
        End With
    Next
    Cells(2, 1).Resize(UBound(tablo), 30) = tablo
End Function

Salut Patrick,
je viens vite fait d'essayer avant de partir au boulot, et j'ai une erreur "91" à "set table" dans la function avec n'importe quel appel "aujourd'hui" "demain" etc...
je regarde çà ce soir en rentrant et te redit...
le 1er code fonctionnait
Seb

Edit:
juste une erreur dans le copier-coller
Code:

1 2 Const linkhyppo = "<a href="http://www.zeturf.fr/fr/programmes-et-pronostics/reunion?id" target="_blank">http://www.zeturf.fr/fr/programmes-e...ics/reunion?id</a>=" Const linkcourse = "<a href="http://www.zeturf.fr/fr/programmes-et-pronostics/course?id" target="_blank">http://www.zeturf.fr/fr/programmes-e...tics/course?id</a>="
remplacé par
Code:

1 2 Const linkhyppo = "http://www.zeturf.fr/fr/programmes-et-pronostics/reunion?id=" Const linkcourse = "http://www.zeturf.fr/fr/programmes-et-pronostics/course?id="
seb

15/02/2016, 15h53
patricktoulon

re

bonjour seb
oui bon j'avais oublié de supprimer les lien dans le wisiwig de dvp
15/02/2016, 20h04
Sebphyto

Re,
Bon ton code est niquel...maintenant je veux récupérer les cotes de chaque partants (gagnant et placé)sur cette page ici...Je souhaite le faire à partir de ton code... Je me penche sur l'affaire et revient poster le code.
tu me diras ce que tu en penses...;)

Seb
16/02/2016, 01h38
patricktoulon

re

re
ben c'est facile tu a le nom le id de la course et le nombre de partants

avec le id et la constantes linkcourse en haut de module tu a le lien de la page tout simplement et cela pour chaque courses

Salut Patrick,

Bon voilà le code pour récup des cotes....Merci pour ton retour

Le seul truc est la vitesse d'exécution, y-a-t-il un moyen de raccourcir celle-ci?

J'ai modifié certaines choses afin de n'avoir que 4 réunions et 8 courses par réunions
Pour la recup cote, j'ai ajouté une sheet "Par courses"

Code:

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

bon sinon en regardant cette page on peut s'apercevoir qu'il y a déjà une actualisation des cotes comme je voulais le faire à h-10mins du départ.
Cette actualisation commence à 8h55 et est actualiser toutes les heures et se termine à h-10min. Ce qui est intéressant, sont les h-10min .
juste à côté il y a les cotes en direct, comme çà par la suite je pourrais faire un delta entre les deux.
donc en regardant bien, j'ai besoin de récupérer quand j'ouvre le fichier le matin par exemple à 10h:
- la cote actualisée (1er colonne tableau site) + cote en direct
- et enfin à h-3min

Seb

16/02/2016, 17h12
patricktoulon

1 pièce(s) jointe(s)

re

Bonjour seb
heu.... bon
ce que j'obtiens avec ton code c'est une ligne avec les noms et les cotes je suppose et cela en au moins 40 seconde c'est plus qu'énorme c'est inconcevable !!!!
Pièce jointe 200967

a priori tu semble avoir plus ou moins compris un system de boucle sur tes tables c'est bien ca fait au moins ca bien qu'il y a des erreurs mais bon c'est pas graves puisque de toute facon
c'est pas ce chemin la qu'il faut prendre

bon je ne sais pas si c'est cela que tu voulais mais question automatisation c'est walouh!!!
quand a l'utilisation de l'UC j'en parle même pas au le pauvre ordi qu'est ce qui morfle

je t'ai donné un code qui:
récupère ce dont tu a besoins pour
soit programmer une tache pour chaque course
soit pour programmer une tache pour chaque temps
c'est pas compliqué

j'ai donc réfléchi a ton soucis qui est :
automatiser tout les X temps une requête pour une course
le second soucis étant ton niveau vba/vbs encore mal compris

j'ai pensé donc que au lieu de programmer X taches pour X course
en programmer UNE SEULE!!!!!!!!!
et cette tache ouvrirais le classeur et le mettrait a jour en fonction de l'heure
pour cela il faudrait que tu organise un second tableau en dessous de celui que je créé avec ma version
dans ce tableau il y aurais 2!!!!!!!! colonnes
id et H-X!!!!!!!!!
et dans le workbook open
récupérer le tableau et boucler sur l'heure la plus proche du moment ou il s'ouvre et je te le donne dans le mille
envoyer la requête avec cette heure récupérée
on pourrais même reprendre ton idé de toutes les X minutes
mais en fait il y aurais qu'ne seul tache par temps pour toutes les courses

ca c'était une premiere idée !!!!!!!!!
maintenant il y en a une autre qui pourrait être plus intéressante dans le sens ou on ouvre pas le classeur
c'est inscrire toute les courses dans le vbs créé et lancer par la tache tri dans les id et heure a l'intérieur de lui même
requête et inscription dans un fichier text temporaire jusque au dernier départ
et a tout moment entre 9.30 et le dernier départ quand tu ouvre ce classeur le mettre a jour avec ce fichier text
c'est pas compliqué
et ton ordi souffre beaucoup moins

1 pièce(s) jointe(s)

re,
merci pour ce retour

Citation:

avec ton code c'est une ligne avec les noms et les cotes

Tu n'obtiens que une ligne, car moi j'ai toutes les lignes de chaque courses???
Pièce jointe 200979

Citation:

mais question automatisation c'est walouh!!!

Ouais je sais, mais j'y arriverai

Citation:

j'ai pensé donc que au lieu de programmer X taches pour X course
en programmer UNE SEULE!!!!!!!!!

dans un 1er temps, parfaitement d'accord avec toi, le seul truc est que je puisse sélectionner la course souhaitée, genre combo...car dans un autre fichier j'ai mes critères de sélection de courses...

Voici ce que j'avais fait avant que tu n'interviennes:
dans un module:

Code:

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
Dim tablo_Cote()
Dim cpt
Public Lacell As Range
Dim Tps As Date
Dim HeurDep
Sub Tempo()
    'HeurDep = "13H50"
 
    'Programmation de l'évènement
    Tps = Now - TimeValue("00:10:00")
    Application.OnTime Tps, "Tempo"
 
    'appel sub Course
    Call Course
 
    'Traitement
    Sheets(2).Range("C1").Value = Format(Now, "hh:nn:ss")
End Sub
 
Sub StopTempo()
    On Error Resume Next
    'Stopper la gestion de l'évènement OnTime en cours
    Application.OnTime Tps, "Tempo", , False
End Sub
Sub Course()
    Dcol = ThisWorkbook.Worksheets("Réunion2").Cells(2, Columns.Count).End(xlToLeft).Column
    Set Lacell = ThisWorkbook.Worksheets("Réunion2").Cells(2, Dcol)
    Lacell.Select
    'Appel sub
    recupCote
End Sub
Public Function recupe_h(url)
    Dim REQ
    Set REQ = CreateObject("microsoft.xmlhttp")
    REQ.Open "POST", url, False
    'Application.Wait Now + TimeValue("0:00:05")
    REQ.send
    recupe_h = REQ.responseText
End Function
Sub recupCote()
    url = "http://www.zeturf.fr/fr/programmes-et-pronostics/course?id=171287"
    cpt = 0
 
    With CreateObject("htmlfile")
                Set doc3 = thedoc3
 
                .write recupe_h(url)
 
                Set cote = .getelementsbytagname("table")
            For nb = 0 To cote.Length - 1
                If cote(nb).className = ("excel") Then
                    Set part = cote(nb).getelementsbytagname("td")
 
                    For nbp = 0 To part.Length - 1
                        If part(nbp).ID Like "*col_odds_single_*" Then
                            ReDim Preserve tablo_Cote(0 To cpt)
                            'Debug.Print part(nbp).innerText
                            tablo_Cote(cpt) = Trim(part(nbp).innertext)
                            'Debug.Print tablo_Cote(cpt)
                            cpt = cpt + 1
                        End If
                    Next nbp
                End If
            Next nb
 
            'retranscrit tablo dans faux doc3
            For c = 0 To UBound(tablo_Cote)
                For Each elem In doc3.all
                    If elem.className = "cot" & c Then
                        elem.innertext = Replace(tablo_Cote(c), ".", ",")
                    End If
                Next elem
            Next c
            'Heure
            For Each elem In doc3.all
                If elem.className = "heur" Then
                    elem.innertext = Format(Now, "h\Hmm")
                End If
            Next elem
 
            'Debug.Print .body.innerHTML
            .body.innerHTML = doc3.body.innerHTML
            Set doc3 = Nothing
            If .parentWindow.clipboardData.setData("Text", .body.innerHTML) Then
                Application.ScreenUpdating = False
                With Sheets("Réunion2") 'Sheets("Réunion" & reunion + 1)
                    .Activate
                    lig = IIf(c < 3, 0, lig + 1)
                    Lacell.Offset(0, lig).Select
                    .Paste
                    With Columns("A:W")
                        .WrapText = False
                        .EntireColumn.AutoFit
                    End With
                End With
                .parentWindow.clipboardData.clearData "Text"
            End If
     End With
End Sub
Public Function thedoc3() As Object
'on construit un table html correspondant a la ligne de la course mais vierge!!!!!!
    Set thedoc3 = CreateObject("htmlfile")
 
    tablefin = "<TABLE class = fin><TR><TD class= heur id= Heure></TD><TR><TD class= cot0></TD></TR>"
    tablefin = tablefin & "<TR><TD class= cot1></TD></TR><TR><TD class= cot2></TD></TR><TR><TD class= cot3></TD></TR><TR><TD class= cot4></TD></TR><TR><TD class= cot5></TD></TR><TR><TD class= cot6></TD></TR>"
    tablefin = tablefin & "<TR><TD class= cot7></TD></TR><TR><TD class= cot8></TD></TR><TR><TD class= cot9></TD></TR><TR><TD class= cot10></TD></TR><TR><TD class= cot11></TD></TR><TR><TD class= cot12></TD></TR>"
    tablefin = tablefin & "<TR><TD class= cot13></TD></TR><TR><TD class= cot14></TD></TR><TR><TD class= cot15></TD></TR><TR><TD class= cot16></TD></TR><TR><TD class= cot17></TD></TR><TR><TD class= cot18></TD></TR>"
    tablefin = tablefin & "<TR><TD class= cot19></TD></TR><TR><TD class= cot20></TD></TR><TR><TD class= cot21></TD></TR><TR><TD class= cot22></TD></TR></TABLE>"
 
    With thedoc3
        .write tablefin
    End With
End Function

dans thisworkbook:

Code:

1
2
3
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTempo
End Sub

C'était un 1er jet

Citation:

maintenant il y en a une autre qui pourrait être plus intéressante

Je suis pour, c'est une bonne idée
seb

16/02/2016, 17h54
patricktoulon

re

et oui ca change pas :ptdr::ptdr:
tu pars sur une idée et après tu y ajoute d'autre paramètres avant t d'avoir conçu la première :ptdr:

donne toute les informations des le départs .dans ta question initiale il n'était pas question de choix de courses et ca ca change la donne complètement

purée tu es le seul a arriver a me décourager :calim2:
je sais pas comment tu fonctionne mais tu devrais prendre des vacances :ptdr: si tu suis pas et que tu saute des étapes c'est pas la peine

reste concentré sur ton idée de base quand tu saura la mettre en œuvre tout seul tu pourras peut être modifier certains paramètre touts seul

mais je regarde tes codes même moi je m'y perds

tu pars trop dans toute les directions
a chaque post tu ajoute ou modifie quelque chose alors que tu n'a même pas encore essayé d'en programmer Une seule !!!! tu ne sais même pas comment on fait :ptdr:
ca deviens difficile de te suivre
prends une décision une fois pour toute et explique la clairement

et surtout quand tu présente une capture d'écran pour démontrer quelque chose que le code que tu a précédemment poster est sensé avoir fait , fait en sorte que ca soit cohérent
car chez moi je n'obtiens pas cela
16/02/2016, 18h21
Sebphyto

1 pièce(s) jointe(s)

Citation:

donne toute les informations des le départs .dans ta question initiale il n'était pas question de choix de courses et ca ca change la donne complètement

Non c juste, mais je m'adapte à ta proposition...si on test que sur 1 course autant que j'ai le choix, en fonction du tablo où il y a les id des courses..

Citation:

purée tu es le seul a arriver a me décourager

Loin de moi cette idée et je m'en excuse alors..;)

Citation:

mais je regarde tes codes même moi je m'y perds

OK, heuu moi je m'y retrouve, qu'ont-ils de si apocalyptique??

Citation:

tu n'a même pas encore essayé d'en programmer Une seule !!!! tu ne sais même pas comment on fait

je compte sur toi pour me montrer...Loll

Citation:

prends une décision une fois pour toute et explique la clairement

- on choisit une course à étudier
- récupérer à l'ouverture du fichier le matin par exemple à 10h la cote actualisée (1er colonne tableau site) + cote en direct
- idem mais à h-10min, comme sur le site, l'actualisation des cote se terminent à h-10min
- et enfin à h-3min

Citation:

et surtout quand tu présente une capture d'écran pour démontrer quelque chose que le code que tu a précédemment poster est sensé avoir fait , fait en sorte que ca soit cohérent
car chez moi je n'obtiens pas cela

Bah, je viens de la relancer et j'obtient bien la même chose
Pièce jointe 200987
seb

Salut Patrick,

Bon je viens de faire une petite chose, création d'un fichier VBS, pour l'ouverture d'un classeur Excel et exécution d'une macro, tout ça avec Notepad, langage Batch et enregistrement format VBS.
C'est peut-être pas grand chose...mais c'est fort intéressant ;)

Dans le fichier VBS:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Option Explicit On Error Resume Next ExempleMacroExcel Sub ExempleMacroExcel() Dim ApplicationExcel Dim ClasseurExcel Set ApplicationExcel = CreateObject("Excel.Application") Set ClasseurExcel = ApplicationExcel.Workbooks.Open("F:\TEST VBS EXCEL\Test VBS.xlsm") ApplicationExcel.Visible = True ApplicationExcel.Run "TestVBS" 'va lancer ma macro "TestVBS" ClasseurExcel.Save ApplicationExcel.Quit Set ClasseurExcel = Nothing Set ApplicationExcel = Nothing End Sub
J'ai ce code, qui pourras lancer la requête, maintenant je regarde pour les h-min.

Dit-moi si je vais dans la bonne direction?

Seb

18/02/2016, 15h46
patricktoulon

re

re
donc ce codes serait le vbs

oui il y a de l'idée
un seul petit soucis le vbs ne peut pas savoir quand le classeur a exécuter la macro rt le ferme de suite
donc dans le vbs il te faut trouver un moyen de contrôler que la macro a fini son travail avant de le fermer
bien que ce soit la première solution que je t'ai proposé je l'ai abandonné aussi tôt je n'aime pas l'idée que le classeur s'ouvre et se ferme sans que je sache si le jobs a été fait correctement
cela dit c'est une avancée majeure dans la compréhension(ENFIN!!!!!) alors je te laisse suivre ce chemin et te donnerait ma solution c'elle que j'ai mis au point quand tu aura fait un exemple fonctionnel
18/02/2016, 15h59
Sebphyto

Ok patrick et merci de ce retour

pour te donner un indice
dans le cadre de la solution que tu semble entrevoir dans ce brouillard
il te faut utiliser une cellule dans la macro testvbs du classeur
j'explique tu prends par exemple la cellule A1 ou celle que tu veux pourvu quelle ne soit pas utilisée ailleurs dans le code vba
quand ta macro démarre elle y met "depart" ou meme rien si tu veux
et quand elle a fini elle y met "fini"

dans ton vbs qui lui lance la macro
tu ajoute un do loop tant que la cellule A1 n'a pas "fini" d'inscrit après tu met ton close et ton quit
pour eviter une surcharge dans le vbs a l'interieur du do lopp tu y met un sleep

code vbs
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 On Error Resume Next ExempleMacroExcel Sub ExempleMacroExcel() Dim ApplicationExcel Dim ClasseurExcel Set ApplicationExcel = CreateObject("Excel.Application") Set ClasseurExcel = ApplicationExcel.Workbooks.Open("F:\TEST VBS EXCEL\Test VBS.xlsm") ApplicationExcel.Visible = True ApplicationExcel.Run "TestVBS" 'va lancer ma macro "TestVBS" do until ClasseurExcel.sheets("nom de ton sheets").cells(X,Y) ="fini" WScript.Sleep(200) loop ClasseurExcel.Save ApplicationExcel.Quit Set ClasseurExcel = Nothing Set ApplicationExcel = Nothing 'et ici tu peut programmer la tache suivante dans le vbs mais au lieu de "create pour schtask tu met "MO" End Sub
la je t'en ai beaucoup dis ;)

18/02/2016, 20h38
mercatog

Bof! il suffit de fermer le classeur et de quitter Excel à la fin de la macro même TestVBS
sans moulinette vbs
18/02/2016, 21h10
patricktoulon

re

re
bonjour oui mercatog aussi

mais dans cet exemple c'est assez facile
mais dans la réalité il va y avoir X requetés de X manières sous X conditions
pour le moment seb essaie d'apprendre a commander excel de l'extérieur ces détails feront partie des ajustements
mais de toute façon on restera pas sur cette méthode car elle presque aussi ridicule que de laisser le classeur ouvert en attente je dis bien presque
tu imagine tu est sur internet entrain de lire un article poff !!!! excel :ptdr::ptdr:

mais c'est surtout a vertu d'apprentissage pour lui
je fait la même chose avec un vbs qui créé un fichier text dans le quel j'inscrit les données récupérées sous forme de tableaux html formatés qui seront transmis au classeur des sa réouverture
et dans ce vbs même je reprogramme la même tache avec "MO"

ce qui a pour conséquence 1 cmd ,1 vbs ,1 tache d'enregistrée et c'est tout wagadougou!!!!

du moins c'est comme ca que je vois les choses et ca fonctionne très bien
18/02/2016, 21h14
mercatog

Bonne continuation donc. La technique est là

Salut Patrick,
Merci pour ton intervention Mercatog...;)

Bon voilà, histoire de m'entrainer
J'ai créé un VBs "TestVBSPat" qui lance la macro "testvbs" dans le classeur "Test VBS.xlsm"....
Puis dans la macro "testvbs", je crée une tache planifiée, qui ouvre un autre vbs créé par macro.
ce vbs ouvre une page internet et la referme, une fois fermée après une tempo, il inscrit dans le classeur feuil1 en cellule A1 "fini"....

Code:

TestVBSPat:

Code:

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
Option Explicit
On Error Resume Next
ExempleMacroExcel
 
Sub ExempleMacroExcel() 
 
  Dim ApplicationExcel 
  Dim ClasseurExcel 
 
  Set ApplicationExcel = CreateObject("Excel.Application") 
  Set ClasseurExcel = ApplicationExcel.Workbooks.Open("F:\TEST VBS EXCEL\Test VBS.xlsm") 
 
  ApplicationExcel.Visible = True   'les actions seront visibles. Pour tout lancer en arrière-plan, remplacer True par False
  ApplicationExcel.Run "TestVBS" 'va lancer la macro "TestVBS"
  do until ClasseurExcel.sheets("Feuil1").cells(1,1) ="fini" 
	WScript.Sleep(200)
  loop 
 
  ClasseurExcel.Save
  ApplicationExcel.Quit 
 
  Set ClasseurExcel = Nothing 
  Set ApplicationExcel = Nothing 
 
End Sub

Macro "testvbs":

Code:

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
Sub testVBS()
    Dim Rep As Integer
    Dim fichierT As String, fichierAB As String, tache As String, abeille As String, x, heureplanifiée, dateTache As String, H As String, Mn As String, Sec As String
        Sheets("Feuil1").Cells(1, 1) = ""
        Rep = MsgBox("Veux-tu lancer le test ?", vbYesNo + vbQuestion, "Macro Sébastien")
        If Rep = vbYes Then
            'MsgBox "Nous sommes le " & Date & ", Nous allons créer une tâche planifiée dans Windows" & vbCrLf & "qui consiste à ouvrir IE " & vbCrLf & "pendant 1min et ecrire en A1 'fini' à la fermeture d'IE", vbOKOnly + vbInformation, "Macro Sébastien"
            Sheets("Feuil1").Cells(1, 1) = "Départ"
            'planifie une tache windows, pour que dans 1mins il inscrive en A1 "fini"
            H = Format(Time, "hh")
            Mn = Format(Time, "nn")
            Sec = Format(Time, "ss")
            heureplanifiée = H & ":" & Val(Mn) + 1 & ":" & Sec
            dateTache = Format(Date, "dd") & "/" & Format(Date, "mm") & "/" & Format(Date, "yyyy")
            'création du code du cmd qui va enregistrer la tache dans windows
            tache = "schtasks /create /sc once /ST " & heureplanifiée & " /sd " & dateTache & " /TR """ & ThisWorkbook.Path & "\abeille1.vbs"" /TN testetache2"
            fichierT = ThisWorkbook.Path & "\tache1.cmd"
            fichierAB = ThisWorkbook.Path & "\abeille1.vbs"
            'cmd de la tache planifiée
             x = FreeFile
            Open fichierT For Output As #x
            Print #x, tache
            Close #x
            'création du vbs pour l'ouverture d'IE
            x = FreeFile
            Open fichierAB For Output As #x
            Print #x, "Dim IE, Classeur, Feuille, wbExcel, appExcel, app" & vbCrLf & _
                    "Set IE = WScript.CreateObject(""InternetExplorer.Application"")" & vbCrLf & _
                    "Set IE = WScript.CreateObject(""InternetExplorer.Application"")" & vbCrLf & _
                    "IE.Visible = 1" & vbCrLf & _
                    "IE.navigate ""http://www.developpez.net/forums/d1567861-3/logiciels/microsoft-office/excel/macros-vba-excel/lancer-requetes-toutes-x-mins/""" & vbCrLf & _
                    "'Attente ouverture IE" & vbCrLf & _
                    "Do While (IE.Busy)" & vbCrLf & _
                    "WScript.Sleep 10" & vbCrLf & _
                    "Loop" & vbCrLf & _
                    "'On laisse IE ouvert 1 min  = 60000 millisec" & vbCrLf & _
                    "WScript.Sleep (500)" & vbCrLf & _
                    "IE.Quit" & vbCrLf & _
                    "On Error Resume Next" & vbCrLf & _
                    "Chemin = ""F:\TEST VBS EXCEL\Test VBS.xlsm""" & vbCrLf & _
                    "Set wbExcel = GetObject(Chemin)" & vbCrLf & _
                    "app = ""Test VBS.xlsm""" & vbCrLf & _
                    "Set appExcel = CreateObject(""Excel.Application"")" & vbCrLf & _
                    "Workbooks(app).Worksheets(1).Activate" & vbCrLf & _
                    "appExcel.Visible = True" & vbCrLf & _
                    "wbExcel.Worksheets(1).Cells(1,1) = ""fini""" & vbCrLf & _
                    "'appExcel.save()"
            Close #x
            SC = """" & fichierT & """ "
            Set oWs = CreateObject("WScript.Shell")
            oWs.Run SC
            Set oWs = Nothing
        Else
 
            Sheets("Feuil1").Cells(1, 1) = "fini"
 
        End If
 
End Sub

J'ai besoin d'un petit éclaircissement, si tu veux bien... pour le tache planifiée que ne se lance pas

si je lance directement le vbs crée par macro, ça fonctionne

Seb

Voir 40 message(s) de cette discussion en une page