Taille du fichier en exponentiel suite requete puis optimisation

**patricktoulon** · 24/07/2015, 10h22

Bonjour sebphyto
allez je me suis lever du bon pied ce matin

on reviend a rien du tout

celui qui marche avec le requete tronque les nom c'est une orreur et chez moi je n'ai pas toujours le meme retour
esaie celui la surprise

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
Sub testesimple21()
    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")
    With IE:
        .navigate URL
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codeinnertext = .document.body.innertext
texte1 = "<div>" & Split(Split(codeinnertext, "Résultat")(1), "PRONOSTICS")(0) & vbCrLf & "</div><BR>"
 
Set mestables = .document.getelementsbytagname("table")
For i = 1 To mestables.Length - 4
texte2 = texte2 & mestables(i).outerhtml
Next
.Quit
End With
 
    With CreateObject("htmlfile")
 
        .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** · 24/07/2015, 11h20

Je suis au boulot, je ne peux pas l'essayer, seulement en début d'après-midi vers 14h
Désolé

**patricktoulon** · 24/07/2015, 11h57

OK
j'ai avancé depuis on verra cet aprem
+

**Sebphyto** · 24/07/2015, 12h07

Re,
dit-moi je ne me rappelle plus pourquoi on avait laissé tomber les code du post #241, as-tu une idée?

car à les essayer ce matin avant de partir au boulot, ils fonctionnaient bien

Seb

**patricktoulon** · 24/07/2015, 12h10

parceque les caractere sont tronqués et chez moi c'est instable c'est normal c'est du a la protection

**Sebphyto** · 24/07/2015, 14h28

Comme c'est beau

J'ai même la fin
Nom : Capture.PNG
Affichages : 138
Taille : 12,4 Ko

**patricktoulon** · 24/07/2015, 19h56

bon alors on continu ?
loi j'en suis la pour le moment

Pièce jointe 183861

**Sebphyto** · 25/07/2015, 11h23

Salut Patrick,

C'est une belle image dans le post #250, belle réussite

Seb

**patricktoulon** · 25/07/2015, 15h05

cest bon j'ai maintenant ta syntheze je vais arranger les titres

Pièce jointe 183890

**Sebphyto** · 25/07/2015, 15h41

De mieux en mieux, j'ai hâte d'essayer et de te dire que ça fonctionne
Seb

**patricktoulon** · 25/07/2015, 15h44

ya qu'a demander

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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Sub testesimple37()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF
    Sheets(1).Cells.ClearContents
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate "http://www.pronostics-turf.info/fg-pronostics-presse.php"
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        codeinnertext = .document.body.innertext: Codehtml = .document.body.innerhtml
        texte1 = Replace("<div>" & Split(Split(Codehtml, "Résultat")(1), "PRONOSTICS")(0) & vbCrLf & "</div><BR>", "</strong>", "<p>")
        Set mestables = .document.getelementsbytagname("table")
        For i = 1 To mestables.Length - 4
            texte2 = texte2 & mestables(i).outerhtml
        Next
        .Quit
    End With
    With CreateObject("htmlfile")
        .body.innerhtml = texte1 & texte2
        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(Replace(mestr(i - 4).outerhtml, "Places", "Cheval"), nextcel, ""), place, "CHEVAL")
                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 = texte1 & table1 & "<BR>" & table2 & "<BR>" & table3
        'on va s'ocuper des titres
        '*******************************************
        'dans ces 3 ligne il y a tout il nous reste a découper le texte de ces trois elements pour tout recupérer ce qui concerne les titres
        oldg = .getelementsbytagname("p")(0).innertext
        prix = .getelementsbytagname("h1")(0).innertext
        newrun = .getelementsbytagname("h1")(1).innertext
        '********************************************
        ' on découpe!!!
        oldate = Split(Split(Replace(oldg, "hui", "hier"), "hier")(1), ":")(0)
        oldate = Format(Replace(oldate, Split(oldate, " ")(1), ""), "dd/mm/yyyy")
        OlDarrivée = Replace(Split(oldg, ": ")(1), " ", "")
        prix = Split(prix, "Prix")(1)
        HiPPo = Split(Split(newrun, "à ")(1), " ")(0)
        newdate = Replace(Split(Split(newrun, "le ")(1), ",")(0), " - ", "/")
        RC = Replace(Replace(Split(Split(newrun, ", ")(1), " Départ")(0), "Réunion", "R"), "Course", "C")
        DsP = Split(newrun, "€)")(1)
 
 
        '************************************************************************************
        '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
        '************************************************************************************
 
        '************************************************************
        'on suprime tout les image et le gif blanks
        For Each elem In .all
            If elem.tagname = "IMG" Then code = Replace(.body.innerhtml, elem.outerhtml, "")
        Next
        If .parentWindow.clipboardData.setData("Text", code) 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

j'ai souffert

**Sebphyto** · 25/07/2015, 16h07

Bon comment te dire....
En pas à pas

ici j'ai une page internet qui s'ouvre

Code :

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

about:blank#_methods=onPlusOne%2C_ready%2C_close%2C_open%2C_resizeMe%2C_renderstart%2Concircled%2Cdrefresh%2Cerefresh&id=I1_1437832302198&parent=http%3A%2F%2Fwww.pronostics-turf.info&pfname=&rpctoken=81537346

Ici lorsqu'il arrive à l'item(66) des "mestr"
J'ai message d'erreur " incompatibilité de type" sur "table3"

Code :

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

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

Ici

Code :

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

 newrun = .getelementsbytagname("h1")(1).innertext

Erreur "91" variable objet ou variable du bloc with non définie

ici

Code :

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

prix = Split(prix, "Prix")(1)

erreur: indice n'appartient pas à la sélection

ici

Code :

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

1
2
3
4
HiPPo = Split(Split(newrun, "à ")(1), " ")(0)
        newdate = Replace(Split(Split(newrun, "le ")(1), ",")(0), " - ", "/")
        RC = Replace(Replace(Split(Split(newrun, ", ")(1), " Départ")(0), "Réunion", "R"), "Course", "C")
        DsP = Split(newrun, "€)")(1)

C'est normal, le message d'erreur car newrun est vide

ici

Code :

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

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

Erreur 91: variable objet ou bloc etc.....

pour un rendu finale, qui s'approche du tien
Nom : Capture.PNG
Affichages : 154
Taille : 31,0 Ko

**patricktoulon** · 25/07/2015, 16h13

donc aujourd'hui tu n'a plus le texte complet du debut

le site a reconnu ton ip il doit jouer avec toi

c'est quand meme formidable ca !!!!!!

bon en tout cas tu a la table d'analyse complete au moins on est d'accord ?

**Sebphyto** · 25/07/2015, 16h33

Yes sir, on est d'accord

une grosse avancée en tout cas je suis content

Bravo à toi

Seb

**patricktoulon** · 25/07/2015, 16h43

j'en conclu donc que si j'enleve toutes les parties textedebut tu n'a plaus d'erreur et tu a la table d'analyse complete sans erreur

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
Sub testesimple39()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF
    Sheets(1).Cells.ClearContents
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate "http://www.pronostics-turf.info/fg-pronostics-presse.php"
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
         Set mestables = .document.getelementsbytagname("table")
        For i = 1 To mestables.Length - 4
            texte2 = texte2 & mestables(i).outerhtml
        Next
        .Quit
    End With
    With CreateObject("htmlfile")
        .body.innerhtml = texte2
        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(Replace(mestr(i - 4).outerhtml, "Places", "Cheval"), nextcel, ""), place, "CHEVAL")
                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
 
        '************************************************************************************
        '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
        '************************************************************************************
 
        '************************************************************
        'on suprime tout les image et le gif blanks
        For Each elem In .all
            If elem.tagname = "IMG" Then code = Replace(.body.innerhtml, elem.outerhtml, "")
        Next
        If .parentWindow.clipboardData.setData("Text", code) 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

c'est OK?
edit / MINCE J'AI PAS DELINKE L'URL DANS LE CODE

**Sebphyto** · 25/07/2015, 18h25

Arrrrggg

Pas tout à fait j'ai toujours une erreur "incompatibilité de type"
Dans la boucle "mestr" item 59

Puis une autre erreur "variable objet ou variable bloc....etc..."
ici:

Code :

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

fois.Children(i).innertext = Val(fois.Children(i).innertext) + 1

Idem ici : [CODE]: synthS.Children(z).innertext = synthW.Children(i).innertext[/CODE

une nouvelle erreur : "Argument non valide"
ici :

Code :

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

If .parentWindow.clipboardData.setData("Text", code) Then

Et du coup j'ai plu rien en sheet1

Ploufplouf

**patricktoulon** · 25/07/2015, 18h27

ca y est j'ai compris pourquoi!!!!!
je viens de faire un load 10 fois de la page pour en observer le rendu au format outerhtml ,innerhtml et innertext
en fait a chaque fois que tu load la page
il y a un script qui la reconstitu mais a chaque fois ordonné différement et le code css(feuille de style) remet tout en ordre a l'affichage

donc a l'affichage la page est la meme mais dans le code html ca ne l'est jamais
donc plutot que de récupérer le debut et les tables
il faut récupérer toutes les balises "p" ,"H",table" peut importe le quel ordre elle sont puisque leur valeur elles restent bonnes
ca va pas changer grand chose dans mon code au final
fait juste ce test on s'en fout de l'ordre ou la cohérence de l'ordre des lignes juste pour voir si tu a bien tout
regarde bien jusque en bas des fois le debut s'i trouve
trop marrant leur truc

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
109
110
111
112
113
114
115
116
117
Sub testesimple40()
    Dim z As Long, pluss As Long, dicoseb, dicopat, mesTRREF
    Sheets(1).Cells.ClearContents
    Set dicoseb = CreateObject("Scripting.Dictionary")
    Set dicopat = CreateObject("Scripting.Dictionary")
    Set IE = CreateObject("internetexplorer.application")
    With IE:
        .navigate "<a href="http://www.pronostics-turf.info/fg-pronostics-presse.php" target="_blank">http://www.pronostics-turf.info/fg-p...ics-presse.php</a>"
        'IE.Visible = True:
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        Set mestables = .document.getelementsbytagname("table")
        Set mesp = .document.getelementsbytagname("p")
        Set mesH = .document.getelementsbytagname("h1")
        For i = 1 To mesp.Length - 1
        If InStr(mesp(i).outerhtml, "Résultat") > 0 Then texte1 = texte1 & mesp(i).innertext & vbCrLf & "<BR>"
        Next
 
        For i = 1 To mesH.Length - 1
         If InStr(mesH(i).outerhtml, "Réunion") > 0 Then texte1 = texte1 & mesH(i).innertext & vbCrLf
        If InStr(mesH(i).outerhtml, "Prix") > 0 Then texte1 = texte1 & mesH(i).innertext & vbCrLf & "<BR>"
 
        Next
        For i = 1 To mestables.Length - 4: texte2 = texte2 & mestables(i).outerhtml & vbCrLf: Next
        .Quit
    End With
    With CreateObject("htmlfile")
        .body.innerhtml = texte2
        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(Replace(mestr(i - 4).outerhtml, "Places", "Cheval"), nextcel, ""), place, "CHEVAL")
                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 = texte1 & table1 & "<BR>" & table2 & "<BR>" & table3
 
        '************************************************************************************
        '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
        '************************************************************************************
 
        '************************************************************
        'on suprime tout les image et le gif blanks
        For Each elem In .all
            If elem.tagname = "IMG" Then code = Replace(.body.innerhtml, elem.outerhtml, "")
        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

si tout se passe bien dans n'importe quelle condition tu dois obtenir ceci:
Pièce jointe 183900

**Sebphyto** · 25/07/2015, 18h33

Non toujours une erreur "mestr (59) et table3
ici:

Code :

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

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

et idem pour les autres erreurs

voici ce que j'ai
Nom : Capture.PNG
Affichages : 155
Taille : 15,2 Ko

**patricktoulon** · 25/07/2015, 18h58

bon?
les erreurs que tu a sont normal apparement tu n'a pas le code html de restitué
on a fait le tour de la question
1 les protections
2 en outerhtml,en innerhtml,innertext
3 avec ou sans script
4 utilisationen amont ou en aval d'un object htmlfile

tu les a un coup oui ,un coup non!!!

il n'y a pas d'internet explorer spécial sebphyto
to system a été réinitialisé donc sensé etre propre

alors je vois 3 raisons possibles

1 soit tu installe un app qui fout le boxon dans tes librairies
2 soit alors ton fournisseur d'acces ,ton parefeu ,ton anti virus te bloque la page en bloquant les script ce qui m'etonnerait beaucoup

3 comme je vois que la page web t'identifie avec ton IP elle te bloque tout simplement au quel cas c'est walouh!!!!!! définitivement

repasse moi le dernier code voir sil n'y a pas d'erreur quand tu copie colle

re j'avoue que je suis perplexe avec toi

tout a l'heure tu avais des erreur avec prix ,oldate,etc..... mais le reste ok
je supprime la partie debut pour que tu n'est que la table d'analyse et voila qu'elle ne fonctionne plus alors que je n'ai rien changer a ca
c'est a se taper la tete contre les murs ton truc
je suis persuadé que c'est toi qui doit faire une erreur quelque part

**Sebphyto** · 25/07/2015, 19h02

Bon, faut que j'y aille, une des versions plus haut semblait fonctionner la 1er code d'aujourd'hui avec des erreurs certes.....
Et si je navigue sur le page avec ip cachée???

seb bonne soirée

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

Macros et VBA Excel

Discussions similaires

Partager

Partager