Taille du fichier en exponentiel suite requete puis optimisation

**Sebphyto** · 23/07/2015, 17h18

Salut Marc et Patrick,

Le script où il y a le + de ligne est le 0 ou 1 j'ai 149 lignes et le 2: 148 lignes (voir post #216 copie d'écran)

Seb

Il serai bien aussi de me dire avec quel code travaillé car j'en est tellement que je ne sais plus???

**patricktoulon** · 23/07/2015, 17h45

on va faire simple
jette tout pour ne pas t'emeler les pinceaux et prend ce code qui est basé sur celui qui fonctionne chez toi
tu dois recevoir un msgbox qui t'affiche le debut de la page au format texte regarde bien si tu a bien tout le cas echeant prend une capture de ce mssage
ensuite la table vient se poser sur le 1 er sheets
j'ai deja préparer les lignes de split moi c'est le 3 toi se sera peut etre un autre debloque les les unes apres les autre en rebloquant la precedente et fait le test

ne t'inquiete pas si il y a des erreurs c'est tout a fait normal puisque tu es senser ne pas avoir toutes les tables selon le script bloqué

allez teste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub testesimple20()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF
    Sheets(1).Cells.ClearContents
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    URL = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate URL
    'IE.Visible = True:
    Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy
    With IE: Codehtml = .document.body.innerhtml: IE.Quit: End With
 
    With CreateObject("htmlfile")
        .Close
        lscript = Split(Codehtml, "<script")
        'Codehtml = Replace(Codehtml, "Split(lscript(1), "</script>")(0) & "</script>", "")
        'Codehtml = Replace(Codehtml, Split(lscript(2), "/script>")(0) & "</script>", "")
        Codehtml = Replace(Codehtml, Split(lscript(3), "</script>")(0) & "</script>", "")
        'Codehtml = Replace(Codehtml, Split(lscript(5), "</script>")(0) & "</script>", "")
        .body.innerhtml = Codehtml
 
       MsgBox .body.innertext
        listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
        Set mestr = .getelementsbytagname("TR")
        For i = 0 To mestr.Length - 1
            For t = 0 To UBound(listPRnst)
                If InStr(mestr(i).OUTERHTML, listPRnst(t)) > 0 Then table1 = table1 & vbCrLf & mestr(i).OUTERHTML
            Next
            'pour la syntheze par points c'est un peu différent mais je la récupère c'est bon cela dit il y a 16 cellules les pronos il y en a que 8
            If InStr(mestr(i).OUTERHTML, "Synthèse") > 0 Then
                mestr(i).ID = "synthW"
                mestr(i - 4).ID = "place"
                nextcel = mestr(i - 4).Children(mestr(i - 4).Children.Length - 1).OUTERHTML
                table2 = "<TABLE>" & Replace(mestr(i - 4).OUTERHTML, nextcel, "") & vbCrLf & mestr(i).OUTERHTML & "</TABLE>"
                table3 = "<TABLE>" & Replace(Replace(mestr(i - 4).OUTERHTML, "Places", "Cheval"), nextcel, "")
                table3 = table3 & "<TR ID=fois><TH> X fois Cité</TH>" & Application.Rept("<TH>0</TH>", mestr(i - 4).Children.Length - 2) & "</TR>"
                table3 = table3 & "<TR>" & "</TR>"
                table3 = table3 & "<TR ID=synthP><TH>syntheze patrick</TH>" & Application.Rept("<TH></TH>", mestr(i - 4).Children.Length - 2) & "</TR>"
                table3 = table3 & "<TR ID=synthS><TH>syntheze Sebphyto</TH>" & Application.Rept("<TH></TH>", mestr(i - 4).Children.Length - 2) & "</TR>" & "</TABLE>"
            End If
 
        Next
        table1 = "<TABLE id=tableref>" & table1 & "</TABLE>"
        .body.innerhtml = table1 & "<BR>" & table2 & "<BR>" & table3
        Set mesTHREF = .getelementbyID("tableref").getelementsbytagname("TH")
        Set fois = .getelementbyID("fois")
        '************************************************************************************
        'nombre de fois cité
        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 senphyto
        Set mesTRREF = .getelementsbytagname("TR")
        For i = 0 To 4    'mesTRREF.Length - 1
            Set mesth = mesTRREF(i).getelementsbytagname("TH")
            For e = 1 To mesth.Length - 1
               Debug.Print mesth(e).innertext
                dicoseb("_" & mesth(e).innertext) = Val(dicoseb("_" & mesth(e).innertext)) + 1
                dicopat("_" & mesth(e).innertext) = dicopat("_" & mesth(e).innertext) + (8 - e)
            Next
 
        Next
 
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                '.Cells.Clear
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
 
End Sub

**Sebphyto** · 23/07/2015, 18h07

donc voici:
Script 1
Nom : script1.PNG
Affichages : 423
Taille : 22,6 Ko

Script 2

Script 3

Script 5

Pour le 3 et 5 j'ai une page internet qui s'ouvre
Nom : Capture.PNG
Affichages : 294
Taille : 5,8 Ko

Et pour tous les scripts j'ai un message d'erreur "Variable objet ou bloc with etc....erreur 91"
ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
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

**Sebphyto** · 23/07/2015, 18h29

Petite question,

dans ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set fois = .getelementbyID("fois")

tu cherches un ID=fois ???

Je me trompes peut-être mais avec F12, je ne vois pas d'ID = "fois", juste "fois" dans une balise <tr>

**patricktoulon** · 23/07/2015, 19h40

c'est le id que j'ai attribué dynamiquement a la ligne pour pouvoir la cibler sans boucler sur toutes les autres ligne de celluleshtml

essai celui la il est simple
et dis moi si tu a tout ce que tu cherche dans le sheets (1)
change le 3 dans le split script pour le tiens ou pas comme tu veux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub testesimple11()
    Dim prix, RC, DsP, HiPPo, base, oldate
    URL = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate URL
    'IE.Visible = True:
    Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy
    With IE: codehtml = .document.body.innerhtml: codeinnertext = .document.body.innertext: IE.Quit: End With
    'getelementsbytagname("blockquote")(1).outerhtml
    'Debug.Print Codehtml
    texte1 = "<div>" & Split(Split(codeinnertext, "Résultat")(1), "PRONOSTICS")(0) & vbCrLf & "</div><BR>"
    With CreateObject("htmlfile")
        .Close
        lscript = Split(codehtml, "<script")
        codehtml = Replace(codehtml, Split(lscript(3), "/script>")(0) & "/script>", "")
        ' on va récupérer les données titre en string les balises html sont entrelacées
        Set mestables = .getelementsbytagname("TABLE")
        .body.innerhtml = codehtml
'on garde que les tablme dans texte2
        For i = 1 To mestables.Length - 1
            texte2 = texte2 & mestables(i).outerhtml
        Next
        'on met les tables et lestexte1 dans le body
        .body.innerhtml = texte1 & texte2
        If .parentWindow.clipboardData.setData("Text", .body.innertext) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

**Sebphyto** · 23/07/2015, 21h43

Niquel avec le script 1 ou 2

**patricktoulon** · 23/07/2015, 21h49

tu es sur d'avoir toutes les tables jusqu'en bas?

on par sur celui la alors

**Sebphyto** · 23/07/2015, 21h53

J'ai jusqu'à Zeturf et à comparer sur le site c bon
Ca c la fin
Nom : Capture.PNG
Affichages : 281
Taille : 10,7 Ko

**patricktoulon** · 23/07/2015, 21h56

oui mais tu n'a pas

x fois cité en 1er
x fois cite en 2eme
etc....
places
liste récapitulative
nombre defois cité
syntheze par points
etc......

oui ou non ?

**Sebphyto** · 23/07/2015, 22h02

non j'ai pas et j'ai essayer avec tous les scripts

**patricktoulon** · 23/07/2015, 22h10

et oui voila le soucis car ta syntheze a toi est basée par la ligne synth par point et le nombre de fois dans le sources choisies

on est donc chocolat
a tu essayer de bloquer plusieur scripts ca peut changer la donne des fois chez moi j'ai des resultat surprenant essaie le 1 et le 3 ou le 2 et le5 etc.......

enfin il faut essayer tout avant d'avancer plus loin j'en ai un peu marre de faire a chaque fois marche arriere alors je te donnerais pas le reste du code tant que tu n'aura pas toutes ces tables

si ca n'est pas possible on sera obligé d'abandonner cette methode et en trouver une autre

ca m'epuise ton truc

**Sebphyto** · 23/07/2015, 22h14

Ok je regarde mais tu bloque comme un script?

si on n'y arrive pas on restera sur ta synthèse et voilà, et voir pour prendre deux ou 3 prono en plus
ainsi que l'indice de confiance

Ca te vas?

**patricktoulon** · 23/07/2015, 22h18

non moi j'ai tout réécris sur ta methode !!!!
je vais ta faire un autre truc

**Sebphyto** · 23/07/2015, 22h20

Regarde sur cette page
http://www.pronostics-turf.info/
Il y a les chevaux par point que l'on cherche

**patricktoulon** · 23/07/2015, 22h45

ok demain ya 0 partants alors

Pièce jointe 183776

**Sebphyto** · 23/07/2015, 22h49

Bah moi j'ai ça
Nom : Capture.PNG
Affichages : 415
Taille : 64,1 Ko

**patricktoulon** · 23/07/2015, 22h53

moi ca je l'ai ailleur
http://www.pronostics-turf.info/

mais je l'avais deja vu depuis longtemps

en dessous chaques ligne de source pronostique il y a du texte en gris certaines ty conduises

ca represent la memechose que la syntheze par point mais que pour la source sous la quelle tu a cliqué

en eau de boudin ce truc
allez change de trajectoire

**Sebphyto** · 23/07/2015, 22h56

Avec ta page, en cliquant dans barre d'adresse et entrée je revient sur ma page
Essai pour voir sinon tant pis

**patricktoulon** · 23/07/2015, 23h00

mais tu es dans quel bled toi pour avoir des redirection pareil

une question aussi est tu inscrit sur ce site ??

c'est vraiment pas normal cette différence on dirrais qu'es dans un autre pays

**Sebphyto** · 24/07/2015, 04h37

J'habite en Haute-Normandie!!!!

en dessous chaques ligne de source pronostique il y a du texte en gris certaines ty conduises

ca represent la memechose que la syntheze par point mais que pour la source sous la quelle tu a cliqué

Ah bon, bah pas pour moi, je tombe toujours sur a même page

une question aussi est tu inscrit sur ce site ??

non

Sinon pourquoi avons nous laisser tomber ce code qui fonctionne très bien, je récupère la synthèse par points et tu fais ton calcul

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub testsinmple()
    Dim ReQ, url As String, listPRnst, prétab, dicosynth
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
    prétab = Application.Rept("<TH> </TH>", 4)
    Set dicosynth = CreateObject("Scripting.Dictionary")
    url = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "get", url, False
    ReQ.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
    ReQ.setRequestHeader "Accept-Language", " fr-FR"
    ReQ.setRequestHeader "User-Agent", " Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    ReQ.setRequestHeader "Accept-Encoding", "gzip, deflate"
    ReQ.setRequestHeader "Host", "www.pronostics - turf.info"
    ReQ.setRequestHeader "DNT", 1
    ReQ.setRequestHeader "Connection", "Keep - Alive"
    'ReQ.setRequestHeader "Cookie", "c_veses = 12"
    ReQ.send
    With CreateObject("htmlfile")
 
        donne = Split(ReQ.responsetext, "<h1>")
        ltext = Split(donne(3), ":")(0)
        madate = Replace(Split(Split(ltext, "le")(1), ",")(0), "-", "/") 'récupère la  date
        RC = "R" & Replace(Split(donne(3), "ion ")(1), "Course ", "C")
        reunion1 = Split(RC, " ")(0) 'récupère la reunion
        course = Split(RC, " ")(1)  'récupère la course
        discipline = Split(Split(Split(donne(3), "<img")(1), "/>")(1), "</")(0) 'récupère la discipline
        prix = Split(Split(donne(2), ":")(1), "</")(0) 'récupère le prix
        hippo = Split(ltext, " ")(0) 'récupère l'hippodrome
 
        'vu que les librairie IE sont inutilisable par rapport au script de protection  je vais traiter la page en string(texte)
        ' c'est pas demain la veille qu'on va m'empecher de choper   du code HTML a moi !!!!!un GROS  LOL!!! pour leur protection a 2 balles
        mestables = (Split(ReQ.responsetext, "<table"))
        For i = 4 To UBound(mestables)
            texte = texte & "<BR>" & "<table" & Split(mestables(i), "</table")(0) & "</table>"
        Next
        'on réecrit le faux doc html avec seulement les données des tables
        .body.innerhtml = texte
        'on supprime tout ce qui n'est pas necessaire (les icon ,image ,src ,etc.....)
        'For Each elem In .all
        'If elem.tagname = "TH" Then elem.innerhtml = elem.innertext
        'Next
        '**********************************************************************************************************
        ' et maintenant que l'on a toutes nos tables dans notre faux doc html
        'on va garder que celles qui nous interesse
        Set mestables = .getelementsbytagname("table")
        For i = 0 To mestables.Length - 1
            For t = 0 To UBound(listPRnst)
                If InStr(mestables(i).outerhtml, listPRnst(t)) > 0 Then tableau = tableau & vbCrLf & "</TR>" & mestables(i).Children(0).Children(0).innerhtml & "</TR>"
            Next
            'pour la syntheze c'est un peu différent mais je la récupère c'est bon cela dit il y a 16 cellules les pronos il y en a que 8
            If InStr(mestables(i).outerhtml, "Synthèse") > 0 Then
                suite1 = mestables(i).getelementsbytagname("TR")(1).outerhtml & _
                        mestables(i).getelementsbytagname("TR")(5).outerhtml
            End If
        Next
        .body.innerhtml = "<table>" & tableau & "<BR>" & suite1 & "</TABLE>"
 
' SYNTHEZE PERSO ******************************************************************************
        Set mestr = .getelementsbytagname("TR")
        For Z = 0 To 4
            Set mesTH = mestr(Z).getelementsbytagname("TH")
            For a = 1 To mesTH.Length - 1
                lPoint = 8 - (a - 1)
                If IsNumeric(mesTH(a).innertext) Then dicosynth(mesTH(a).innertext) = dicosynth(mesTH(a).innertext) + 8 - (a - 1)    'lPoint
            Next
        Next
        synthperso = "<TR><TH> Ma synthèse perso</TH>"
        Do
            pt = pt + 1: old = 0
            For Each elem In dicosynth
                If dicosynth(elem) > old Then
                    cehtml = "<TH>" & elem & "</TH>"
                    old = dicosynth(elem): items = elem
                End If
            Next
            dicosynth(items) = 0
            synthperso = synthperso & "<TH>" & items & "</TH>"
        Loop Until pt = dicosynth.Count
        synthperso = synthperso & "</TR>"
' FIN DE SYNTHEZE PERSO ****************************************************************************
        .body.innerhtml = "<table>" & tableau & "</TABLE>" & "<BR>" & "<table>" & suite1 & synthperso & "</TABLE>"
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.ClearContents
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

on n'a voulu le faire évoluer pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'- Bilto
'- Agence TIP
'- Equidia
'- Stato turf
'- Paris turf
'- Synthèse par point
Const arrivé = "<TH>-</TH><TH>-</TH><TH>-</TH><TH>-</TH><TH>-</TH>"
Const head = "<TR><TH class=ldate>Date</TH><TH class=course>Course</TH><TH class=source>Source</TH><TH  class=titreprono colspan=8> PRONOSTIQUE</TH><TH class=titrearriv colspan=5>Arrivée</TH></TR><TR><TH> </TH><TH> </TH><TH> </TH><TH>1 er</TH><TH> 2em</TH><TH>3em</TH><TH>4em</TH><TH>5em</TH><TH>6em</TH><TH>7em</TH><TH>8em</TH><TH>Arr 1</TH><TH>Arr 2 </TH><TH>Arr 3 </TH><TH>Arr 4 </TH><TH>Arr 5 </TH></TR>"
 
'url de base "http://www.pronostics-turf.info/fg-pronostics-presse.php"
 
Sub testsinmple()
Dim ReQ, url As String, listPRnst
    listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
'Synthèse par points
    url = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "get", url, False
    ReQ.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
    ReQ.setRequestHeader "Accept-Language", " fr-FR"
    ReQ.setRequestHeader "User-Agent", " Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    ReQ.setRequestHeader "Accept-Encoding", "gzip, deflate"
    ReQ.setRequestHeader "Host", "www.pronostics - turf.info"
    ReQ.setRequestHeader "DNT", 1
    ReQ.setRequestHeader "Connection", "Keep - Alive"
    'ReQ.setRequestHeader "Cookie", "c_veses = 12"
    ReQ.send
 
    With CreateObject("htmlfile")
        donne = Split(ReQ.responsetext, "<h1>")
        ltext = Split(donne(3), ":")(0)
        madate = Replace(Split(Split(ltext, "le")(1), ",")(0), "-", "/")
        RC = "R" & Replace(Split(donne(3), "ion ")(1), "Course ", "C")
        reunion1 = Split(RC, " ")(0)
        course = Split(RC, " ")(1)
 
        'vu que les librairie IE sont inutilisable par rapport au script de protection  je vais traiter la page en string(texte)
 
        mestables = (Split(ReQ.responsetext, "<table"))
        For i = 4 To UBound(mestables)
            texte = texte & "<BR>" & "<table" & Split(mestables(i), "</table")(0) & "</table>"
        Next
        'on réecrit le faux doc html avec seulement les données des tables
        .body.innerhtml = texte
 
        'on supprime tout ce qui n'est pas necessaire (les icon ,image ,src ,etc.....)
        'For Each elem In .all
            'If elem.tagname = "TH" Then elem.innerhtml = elem.innertext
        'Next
'**********************************************************************************************************
        ' et maintenant que l'on a toutes nos tables dans notre faux doc html
        'on va garder que celles qui nous interessent
        Set mestables = .getelementsbytagname("table")
        For i = 0 To mestables.Length - 1
            For t = 0 To UBound(listPRnst)
                If InStr(mestables(i).outerhtml, listPRnst(t)) > 0 Then texte2 = texte2 & vbCrLf & "<TR><TH>-</TH><TH>-</TH>" & _
                mestables(i).Children(0).Children(0).innerhtml & arrivé & "</TR>"
              Next
      'pour la synthèse c'est un peu différent mais je la récupère c'est bon cela dit il y a 16 cellules les pronos il y en a que 8
      If InStr(mestables(i).outerhtml, "Synthèse") > 0 Then Set lignesyntpoints = mestables(i).getelementsbytagname("TR")(5)
       Next
 
 For Each elem In lignesyntpoints.all
 If elem.tagname = "TD" Then temp = temp & "<TH>" & elem.innertext & "</TH>"
       'Debug.Print mestables(i).getelementsbytagname("TR")(5).outerhtml & vbCrLf & "************************************" & vbCrLf
      Next
  texteSYNT = texteSYNT & "<br><TR>" & temp & "</TR>"
 entetetemp = "<TR><TH  class= titresynt colspan=" & lignesyntpoints.Children.Length & ">syntheze Génerale</TH></TR><TR><TH> Places :</TH>"
  For i = 1 To lignesyntpoints.Children.Length - 1
   entetetemp = entetetemp & "<TH>" & i & "</TH>"
Next
entetetemp = entetetemp & "</TR>"
 '.body.innerhtml = ""
 .body.innerhtml = "<table>" & head & texte2 & entetetemp & texteSYNT & "</table>" & "<BR>"
Set mestr = .getelementsbytagname("TR")
 mestr(1).Children(0).innertext = madate
mestr(1).Children(1).innertext = reunion1 & course
'****************************************************************************************************************
        'maintenant un peu de style et de couleur pour égailler notre tableau
 
      For Each elem In .all
      If elem.tagname = "TH" Then elem.Style.Border = 1 & " dotted " & "#000000"
      If elem.classname = "titreprono" Then elem.Style.Background = "#DF7401"
      If elem.classname = "titrearriv" Then elem.Style.Background = "#31B404"
    If elem.classname = "source" Then elem.Style.Background = "#FACC2E"
    If elem.classname = "course" Then elem.Style.Background = "#F5DA81"
    If elem.classname = "ldate" Then elem.Style.Background = "#58FA82"
    If elem.classname = "titresynt" Then elem.Style.Background = "#DF7401"
    Next
 
       'Debug.Print .body.innerhtml
 
 
 
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(3)
                .Activate
                Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
                .Paste
 
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
 
 
    End With
End Sub

on peut peut-être revenir à ça, soit l'un ou l'autre et y intégrer mon calcul, voir ne pas faire le calcul directement dans le fauxdochtlm vu que c'est à partir de là que ça a commencé à bricoler, et le faire après dans la feuille excel.
idem pour la récup du prix ce n'est pas nécessaire, après on a voulu récup l'arrivée etc...

on était parti de ce bout de code pour les data de la bdd sans le prix ou ça merd...:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub testsinmple6()
    Dim prix, RC, DsP, HiPPo, base, olddate
    URL = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate URL
    'IE.Visible = True:
    Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy
    With IE: codehtml = .document.body.innerhtml: IE.Quit: End With
    'getelementsbytagname("blockquote")(1).outerhtml
    'prix = Split(Split(Split(codehtml, "<h1>")(2), "QUINTE: ")(1), "</font>")(0)
    base1 = "<h1>" & Split(Split(codehtml, "<h1>")(3), "</h1>")(0)
    RC = Replace("R" & Split(Split(base1, "Réunion")(1), "Départ")(0), "Course", "C")
    HiPPo = Split(Split(base1, " ")(1), " ")(0)
    lDate = Replace(Replace(Split(Split(base1, "le ")(1), ",")(0), " - ", "/"), " d'hier", "")
    base2 = Split(Split(codehtml, "<h1>")(1), "Arrivée du QUINTE PMU")(1)
    olddate = Format(Replace(Split(Split(base2, ":")(0), "&nbsp;")(1) & "/" & Split(Split(base2, ":")(0), "&nbsp;")(2), "  ", "/"), "dd/mm/yyyy")
     OldArrivée = Replace(Split(Split(base2, ":")(1), "</p> ")(0), " ", "")
 
     'Debug.Print olddate & vbCrLf & lDate & vbcrlf
  mess = mess & "Date  de la course precedente :  " & olddate & vbCrLf
  mess = mess & "Arivée  de la course precedente :  " & OldArrivée & vbCrLf
  mess = mess & "*********************************" & vbCrLf
    mess = mess & "date du jour :  " & lDate & vbCrLf
mess = mess & "Prix de la course du jour :  " & prix & vbCrLf
mess = mess & "Hippodrome de la course du jour :  " & HiPPo & vbCrLf
mess = mess & " reunion et course :  " & RC
MsgBox mess
End Sub

Je pense que l'o peut repartir sur cela et rester simple,
La on n' a avec les 3 code au-dessus:
-Recup prono
-Recup synthèse
-ton calcul (voir pour le mien directement sur une sheet sans passer par fauxdochtlm)
-recup arrivée, date, hippo

après il faudra:
-récup rapport
- calcu indice de forme (ex dans la sheet directement)
- rangement bdd
Seb

Taille du fichier en exponentiel suite requete puis optimisation [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager