Pilotage Internet Explorer

**itwoo** · 13/12/2014, 07h54

Bonjour,

Merci Pat pour ton code post#293 (euronext méthode alternative) en fait la pop up s'ouvre se referme mais rien ne se passe...ca doit pas être trop grave à modifier...faudra voir ca...pour le moment étude des abeilles de Marc...
A bientôt
Bon WE

**patricktoulon** · 13/12/2014, 18h47

pour le moment étude des abeilles de Marc...

Les abeilles ???......,c'est la méthode employée dans la version 1.5 de Euronext all equities

que j'ai faite spécialement pour toi

patience le 25 c'est l'apocalypse je lâche les bombes ca va faire du bruit

**Marc-L** · 14/12/2014, 20h00

Envoyé par itwoo

code post#293 (euronext méthode alternative) en fait la pop up s'ouvre se referme mais rien ne se passe...

Cela me rassure, je vais attaquer une nouvelle contribution …

Déjà lundi dernier le site Euronext était à l'Ouest mais alors ce week-end !
J'attends un retour à la normale pour finir de tester …

**itwoo** · 16/12/2014, 07h50

Bonjour,

Pat fait nous un beau feu d'artifice que l'on reste en admiration

Oui ici étude des abeilles (de ta version all equities en effet) car il faut corriger les retours liens défectueux ca progresse de ce côté là...
Tu remarqueras que durant la journée, all equities et le clic sur le bouton download ne donnent pas le même résultat car le download ne te fournit que les cours de la veille...alors que all equities te fournit les cours actuels...
C'est pourquoi il y a une différence d'ou l'étude intensive pour all equities

marc oui super idée avec les sendKey peut être?

Bonne journée

**Marc-L** · 16/12/2014, 10h15

Oui, entre autres …

**itwoo** · 22/12/2014, 11h45

Bonjour,

En fait il me manque des connaissances sur un point (et je ne le trouve pas ni en faisant des essais ni sur le net)

Il s'agit de remonter depuis le fichier.vbs les informations traitées et fournies par ce fichier.vbs pour pouvoir les traiter dans le code VBA par exemple sous forme texte, booléan...
Par exemple un ajoutant un argument au script (mais ca retourne toujours vide pour le moment) ou alors par exemple avec un getobject de la même façon que tablo2 est récupéré puis mis sur la feuille excel (pas réussi par exemple à le faire apparaitre dans le code vba non plus sous forme du type datas= tablo2):
exemple pour tablo2 :

Code :

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

Réinjection = "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Resize(UBound(tablo2), 7) = tablo2"

Donc pour un booléan une syntaxe du style:

Code :

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

Réinjection = "GetObject(, ""Excel.Application"").boolean=Bg"

et pour une string

Code :

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

Réinjection = "GetObject(, ""Excel.Application"").string=DemandeFichier.responseText"

Ça semble tout simple mais pour le moment pas moyen d'y arriver...
Merci pour votre aide

PS: Pat revérif en cours de ta version V1.5 mais pas sûr que le Do loop Until marche bien...

**Marc-L** · 22/12/2014, 14h36

J'ai tenté uniquement l'écriture directe dans une cellule d'une feuille de calculs.

Même en réussissant le retour dans une variable liée au module de la feuille,
il n'y aurait aucun moyen de le détecter via un évènement …

**itwoo** · 22/12/2014, 22h26

tu veux dire qu'il n'est pas possible de récupérer par getobject autrement que sur la feuille excel? ou que si jamais il était possible d'y parvenir cela ne serait même pas détecté?

Pour le moment test sur 3 solutions pour voir si ca marche:
a)comme version V1.5 de corriger dans le script directement
b) vérifier une fois tous les scripts chargés s'il y a des cellules vide sur la feuille excel
c)vérifier une fois tous les scripts chargés les fichiers response i s'ils ont bien les bonnes datas

**patricktoulon** · 22/12/2014, 22h31

Envoyé par Marc-L

J'ai tenté uniquement l'écriture directe dans une cellule d'une feuille de calculs.

Même en réussissant le retour dans une variable liée au module de la feuille,
il n'y aurait aucun moyen de le détecter via un évènement …

Pas si sur!Marc
Avec le getobject sur l'application excel envoyer a chaque fois un string dans une cellule
Prévu a cet effet exemple 0 ou 1 et se servir de ça dans le sheetchange
Il me semble avoir livre une version qui déjà entrevoyait ce soucis
Patience bientôt l'object IE sera remplace par fire foxe
Non t'inquiet j'ai pas craque se sera ma premiere bombe
Bientot firefoxe/VBA sera une realite
Sa va faire BOUM!

**itwoo** · 23/12/2014, 14h35

Bonjour,

Ok Pat pour Firefox et ta bombe

en attendant pour reprendre la modification du vbs script et bien en fait c'est la sortie du script qui pose probléme:
Progrés en cours la fin approche grâce à vous...le fichier.vbs détecte l'erreur+relance la requête suite à modification de son code (solution a) retenue) avec un do loop comme fait par Pat en version v1.5...tests en cours car il y a encore des imperfections...je ne suis pas sûr quand même du résultat...car WScript.Quit 1 ne veut pas marcher, COMMENT QUITTER LE SCRIPT DE MANIERE FORCEE?
Explications: pour simuler une erreur pour faire les tests au lieu de "error":True pris sur le 3° script un ISIN "FR0000031122" celui d'Air France et bien excel indique bien erreur script n°2 et b=10 mais ensuite le script continue c'est à dire qu'il va bien afficher tablo2 avec ses datas alors que normalement il devrait s'arrêter avec WScript.Quit 1 pour passer au script suivant...cela aprés avoir fait 9 tentatives de relance du script pour récupérer les datas...(on voit bien que le script continue car il va aussi afficher sur la feuille excel les datas du 3° script)

Voici le code du CREATION DU VBS unique

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
Sub creationvbs2()
 
    Dim texte As String, Header As String, sending As String, Réinjection As String, Parser As String, FSys As Object, MonFic As Object
    Dim Reponse As String, verif As String
 
    texte = "dim tablo,tablo2(20,7)" & vbCrLf
    texte = texte & vbCrLf & "Do"
    texte = texte & vbCrLf & "b=b+1"
    texte = texte & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
    texte = texte & vbCrLf & "DemandeFichier.Open ""POST" & """, WScript.Arguments(0), False"
 
    Header = "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Referer"", ""https://europeanequities.nyx.com/fr/equities-directory""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0""" & vbCrLf
 
    ARGTS_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=""" & "& WScript.Arguments(1) & " & """&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
 
    Header = Header & "DemandeFichier.send " & ARGTS_send
 
    'ici ajout de if status = 200 pour être sûr que le script revient bien oui mais pose probléme avec le Do
    'car le loop n'est plus intégré avec le do car le loop dans le If
    'statut_debut = "If DemandeFichier.status =200 then"
    response = "str_demande_fich = DemandeFichier.responseText"
 
     'null n'est pas un filtre suffisamment efficace donc plutôt mettre "error":true
     'par précuation mettre un rupteur pour b par exemple 10
     verif = "If b>9 then MsgBox(""Erreur script n°"" & WScript.Arguments(1)/20 & ""b= "" & b ) : Exit Do: WScript.Quit 1"
     'ici pour faire des test suppression de la condition sur verif
     'verif = verif & vbCrLf & "Loop While (instr(str_demande_fich, """"""error"""":true"")>0) " 'comme pas d'erreur
     'provocation d'une erreur volontaire avec un isin en 3° script FR0000031122 Air France...
     verif = verif & vbCrLf & "z = instr(str_demande_fich, ""FR0000031122"")>0"
     verif = verif & vbCrLf & "Loop While instr(str_demande_fich, ""FR0000031122"")>0"
     verif = verif & vbCrLf & "If b=10 then MsgBox(""Script non quitté WScript.Quit 1 défectueux car pourtant instr= "" & z)"
 
    Réinjection = "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Resize(UBound(tablo2), 7) = tablo2"
    'Réinjection = Réinjection & vbCrLf & "GetObject(, ""Excel.Application"")= DemandeFichier.responseText" 'ne
    'donne rien
 
    'statut_fin = "Else MsgBox(""Erreur script n°"" & WScript.Arguments(1)/20 & "" statut <>200"")"
    'statut_fin = statut_fin & vbCrLf & "End If"
    Parser = "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "reponse = reponse & tablo2(Z, 0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 1)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 2)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 3)" & vbCrLf & _
             "tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 4)" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 6)" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 5) & vbcrlf" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"
     Reponse = "reponse = reponse & vbcrlf & str_demande_fich" 'ici response à toutes les datas de tablo2
     '+ demandefichier.responsetext
 
    texte = texte & vbCrLf & Header & vbCrLf & statut_debut & vbCrLf & response & vbCrLf & verif & vbCrLf & Parser & _
    vbCrLf & Reponse & vbCrLf & Réinjection & vbCrLf & statut_fin
    'ici il faut mettre Reponse pour récupérer tablo2 et DemandeFichier.responseText
 
     enreg = "Set FSys = CreateObject(""Scripting.FileSystemObject"")"
     enreg = enreg & vbCrLf & "Set MonFic = FSys.CreateTextFile(""C:\Users\euronext_all_equities140802\response\response"" & WScript.Arguments(1)/20 & "".txt"")"
     enreg = enreg & vbCrLf & "With MonFic" & vbCrLf & ".write reponse" & vbCrLf & "End With"
 
    texte = texte & vbCrLf & enreg
 
    With ThisWorkbook
        'On copie le code dans un fichier
        Set FSys = CreateObject("Scripting.FileSystemObject")
        Set MonFic = FSys.CreateTextFile(.Path & "\requeteallequities" & ".vbs")
        With MonFic    'Pour écrire dans le fichier texte
            .write texte
        End With
    End With
End Sub

Une solution sinon utiliser tout à la fin du script z pour mettre tablo2="" => if z= vrai then tablo2="" mais ca serait mieux de quitter le script lorsque b=10 plutôt que d'aller jusqu'à la fin

**Marc-L** · 24/12/2014, 01h18

itwoo, j'ai un peu tardé pour la contribution pour télécharger le fichier csv d'Euronext par manque de temps
mais aussi car il y a deux week-ends, le site a bien ramé et depuis je ne retrouve plus les mêmes performances,
étant descendu sous les cinq secondes !

La contribution est ici, tout du moins la première étape en y attendant ton retour avant de la poursuivre …
Elle t'est réservée jusqu'à la clôture de la dernière étape !

**itwoo** · 24/12/2014, 07h14

Bonjour,

D'accord pas de soucis je vais voir tout cela aussi...vraiment un grand merci à toi, Pat et tout le monde
Grande nouvelle ca y est le WScript.Quit marche (il ne marchait pas car mis aprés le Exit do ...donc pas vu par le VBScript!!!)
Le seul point encore en suspend reste le i de WScript.Quit i, comme i ne marchait pas une astuce en attendant à consister à le forcer
Version des abeilles qui normalement marche sans erreur sauf si cela vient du réseau (mais il y a quand même 9 tentatives de lancement avant de quitter):
Ici pour le test il y a une erreur volontaire sur le 3° script et la réponse retournée sera en colonne A juste le n° du script défectueux pour éventuellement plus tard effectuer une relance...lorsque le réseau sera denouveau opérationnel...
Pat et Marc êtes vous d'accord avec cela?
Ensuite pour avoir la bonne version il suffira de remplacer la condition si l'isin FR0000031122 par """"error"""":true pour tests...et atttendre qu'une erreur se produise pour voir si vraiment ca marche!!!

Passez de bonnes fêtes

PS: serais de retour vers le 01 janvier et Pat il reste ta version Ultimate aussi à voir!!!+Marc automation!!!
Bien il semble que cela marche mais c'est avec le temps qu'il va falloir voir cela...ne pas crier victoire trop vite...de plus pour l'affichage il manque toujours un fond violet (correction pour bientôt)

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
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                                   CREATION DU VBS UNIQUE
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
 
 
Sub creationvbs2()
'cette sub va écrire le texte des requêtes vbs (en fait toutes les requêtes sont écrites dans un seul fichier *.vbs
 
    Dim texte As String, Header As String, sending As String, Réinjection As String, Parser As String, FSys As Object, MonFic As Object
    Dim Reponse As String, verif As String
 
    texte = "dim tablo,tablo2(20,7)" & vbCrLf
    texte = texte & vbCrLf & "Do"
    texte = texte & vbCrLf & "b=b+1"
    texte = texte & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
    texte = texte & vbCrLf & "DemandeFichier.Open ""POST" & """, WScript.Arguments(0), False"
 
    Header = "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Referer"", ""https://europeanequities.nyx.com/fr/equities-directory""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0""" & vbCrLf
 
    ARGTS_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=""" & "& WScript.Arguments(1) & " & """&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
 
    Header = Header & "DemandeFichier.send " & ARGTS_send
 
    'ici ajout de if status = 200 pour être sûr que le script revient bien
    statut = "If DemandeFichier.status <>200 then MsgBox(""Pas de retour de connexion""):z =100:WScript.Quit 100"
    response = "str_demande_fich = DemandeFichier.responseText"
 
     'par précuation mettre un rupteur pour b par exemple 10
     verif = "If b>9 then"
     verif = verif & vbCrLf & "MsgBox(""Erreur script n°"" & WScript.Arguments(1)/20 & ""b= "" & b )"
     verif = verif & vbCrLf & "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Value = WScript.Arguments(1)/20"
     'pour afficher le n° du script défectueux dans la cellule en colonne A (il servira ensuite si besoin d'une
     'relance manuelle à faire plus tard car pour le moment malgré 9 tentatives le script reste défectueux
     'comme le Quit i ne marche pas création d'un Err.num...
     'verif = verif & vbCrLf & "Err.num=1 : MsgBox(""Quit n° "" & Err.num)" 'marche pas bien, message non géré
     verif = verif & vbCrLf & "z=1 : MsgBox(""Quit n° "" & z)"
     'verif = verif & vbCrLf & "WScript.Quit" 'WScript.Quit  marche
     'verif = verif & vbCrLf & "WScript.Quit()" 'WScript.Quit  marche
     verif = verif & vbCrLf & "WScript.Quit 1" 'WScript.Quit 1 marche mais 1 n'apaprait pas
     'verif = verif & vbCrLf & "WScript.Quit(1)" 'WScript.Quit 1 marche mais 1 n'apaprait pas
     verif = verif & vbCrLf & "Exit Do" 'le WScript.Quit étant actif exit do ne sert plus à rien
     verif = verif & vbCrLf & "End If"
 
     'ici pour faire des test suppression de la condition sur verif
     'verif = verif & vbCrLf & "Loop While (instr(str_demande_fich, """"""error"""":true"")>0) " 'comme pas d'erreur
     'provocation d'une erreur volontaire avec un isin en 3° script FR0000031122 Air France...
     verif = verif & vbCrLf & "Eg = instr(str_demande_fich, ""FR0000031122"")>0"
     verif = verif & vbCrLf & "Loop While instr(str_demande_fich, ""FR0000031122"")>0"
 
     'ici ce message ne s'affiche plus si b=10 le Wscript.Quit a fait quitter le script=>
     verif = verif & vbCrLf & "If b=10 then MsgBox(""Script non quitté WScript.Quit 1 défectueux car pourtant instr= "" & Eg)"
     'verif = verif & vbCrLf & "If b=10 then MsgBox(""Script non quitté WScript Quit défectueux car pourtant instr= "" & instr(str_demande_fich, ""FR0000031122"")>0)"
 
    Réinjection = "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Resize(UBound(tablo2), 7) = tablo2"
 
 
    Parser = "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "reponse = reponse & tablo2(Z, 0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 1)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 2)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 3)" & vbCrLf & _
             "tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 4)" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 6)" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 5) & vbcrlf" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"
     Reponse = "reponse = reponse & vbcrlf & str_demande_fich" 'ici response à toutes les datas de tablo2
     '+ demandefichier.responsetext
 
    texte = texte & vbCrLf & Header & vbCrLf & statut & vbCrLf & response & vbCrLf & verif & vbCrLf & Parser & _
    vbCrLf & Reponse & vbCrLf & Réinjection
    'ici il faut mettre Reponse pour récupérer tablo2 et DemandeFichier.responseText
 
     enreg = "Set FSys = CreateObject(""Scripting.FileSystemObject"")"
     enreg = enreg & vbCrLf & "Set MonFic = FSys.CreateTextFile(""C:\Users\euronext_all_equities140802\response\response"" & WScript.Arguments(1)/20 & "".txt"")"
     enreg = enreg & vbCrLf & "With MonFic" & vbCrLf & ".write reponse" & vbCrLf & "End With"
 
    texte = texte & vbCrLf & enreg
 
    With ThisWorkbook
        'On copie le code dans un fichier
        Set FSys = CreateObject("Scripting.FileSystemObject")
        Set MonFic = FSys.CreateTextFile(.Path & "\requeteallequities" & ".vbs")
        With MonFic    'Pour écrire dans le fichier texte
            .write texte
        End With
    End With
End Sub

**itwoo** · 01/01/2015, 10h43

Bonne année

Pat tu sais tes versions marchaient quasi parfaitement, en fait il y a des petites modif de rien du tout à faire:
pour l'affichage fond violet le dernier manquant sur la version V1.02 pour corriger il a suffit de rajouter +1 dans le code de la feuil1:

Code :

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

If comptechangement = NBPAGES + 1 Then 'ici il faut bien NBPAGES+1 car de 0 à NBPAGES cela fait bien NBPAGES+1 affichages pour worksheet_change

de même pour oldtarget il faut le rendre Public car sinon oldtarget="" (cela dit oldtarget n’a pas d’influence ici)

Et pour les boucles do loop du fichier vbs (ce point toujours en test dans l'attente d'avoir ou non une erreur) et bien en fait c'est la syntaxe semble t'il qui faisait défaut a savoir le nombre de ":

Code :

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

If instr(str_demande_fich, """"""error"""":true"")>0 then

PAt tu as fait un travail FORMIDABLE Merci à toi

Marc idem merci pour tout

Qwaz toujours là si besoin thank you

Et merci à tout le monde

Normalement tests et versifications en cours mais tout doit marcher

PS: Pat si tu as une version Firefox une amélioration...je suis preneur avec grand plaisir

**itwoo** · 07/01/2015, 18h55

Bonjour,

Pat une petite question toute simple peux tu me redire comment faire pour inserer un commandbutton telecharger les requetes sur la feuille excel stp...car excel refuse merci
Pour le moment test en cours ca semble tenir mais c'est encore trop tôt pour crier victoire...

**Marc-L** · 07/01/2015, 19h14

Bonjour,

si tu ne retrouves pas la barre d'outils Formulaires, voici par code :

ActiveSheet.Buttons.Add(187.2, 25.8, 124.8, 27.6).Caption = "Télécharger les requêtes" …

_________________________________________________________________________________________________
Hebdo du jour : je suis Charlie …

**Marc-L** · 08/01/2015, 09h16

Je suppose que tu n'es pas sous la version 2003, tout y est plus facilement accessible !

La barre d'outils Formulaires permet de créer directement un bouton non ActiveX sur une feuille de calculs.

Patrick a l'air d'être occupé en ce moment, le mieux est d'ouvrir une nouvelle discussion pour ce problème
en n'oubliant pas d'indiquer dans le titre la version d'Excel utilisée, d'autres intervenants pourront t'aider …

_________________________________________________________________________________________________
Je suis Charlie

Jour d'ouverture des soldes : liquidation totale chez Charlie Hebdo …

Un scientifique lira des centaines de livres au cours de sa vie, mais sera toujours persuadé qu'il lui reste beaucoup à apprendre.
Un religieux n'en lira qu'un et sera persuadé d'avoir tout compris …

**itwoo** · 08/01/2015, 10h14

Pat pour l'affichage du fond violet en fait la correction en sheets(1)

Code :

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

comptechangement = NBPAGES + 1

qui doit être faite pour toutes les versions VBS marche bien mais pour la version v1.5 elle n'est pas suffisante car le code de la sheets(1) a été modifié besoin de temps pour finir ce point.

Sinon pour info pour le moment pas d'erreur du retour de tes abeilles Marc!!! et Pat la boucle do loop semble marcher et tenir...
ca avance vraiment bien là maintenant c'est vraiment merveilleux

merci à vous 2 et tous les autres...
@+

**itwoo** · 14/02/2015, 09h50

Bonjour,

Tests en cours mais pour l'instant plus d'erreur ni d'affichage ni de chargement des datas avec la mise en place de la relance...
Par contre le code a été légérement modifié pour supprimer parfois si elle existe la queue de fichier des datas qui ne retourne pas de données mais lance bien un script (qui revient donc vide sans data) et qui incrémente l'affichage sur la feuille excel, les seules datas de ce script sont: {"sEcho":"5","iTotalRecords":0,"iTotalDisplayRecords":0,"aaData":[],"error":false} avec "error":false qui est bien différent du cas "error":true ou là il y a un probléme sur la récupération des datas...
De même il y a bien un rupteur pour sortir aprés n boucle (ici 10) s'il y a une erreur lors du script pour obtenir les retour des datas...cas "error": True

test et édition en cours pour afficher la version finale...d'ici quelques jours si tout va bien!!!

**itwoo** · 18/02/2015, 15h55

Bonjour,

Merci Pat pour toute ton aide, idem à Qwaz, Marc...

Il reste le retour de script défectueux pour bien tester si la sécurité mise marche, mais actuellement il n'y a plus de retour de script défectueux!!!

Pour finir voici donc le code de la Feuil modifié pour obtenir une bonne présentation pour la version V1.5:

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
Private Sub CommandButton1_Click()
    'CommandButton1 est le bouton de la feuil1 télécharger les requêtes
EURONEXT_ALL_EQUITIES 'appel de la sub euronext_all_equities
End Sub
 
Private Sub CommandButton2_Click()
passe_par_IE
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If schplage = True Then
         'si schplage = True cela ne se produit que pour la fin de la requête lors de son lancement pour le retour
    'des datas
        Set plage = Range(Target.Address)
        'défini plage
        If Target.Column < 8 Then  'ici pour n'agir que sur les 8°colonnes pour le lancement de cadre
        'plage
          If Target.Column <> 2 Then cadre plage 'ici dans la cas de la colonne B il n'y a pas affichage du cadre car c'est le
        'cas de fin de queue des datas echos:true voir sub creationvbs2
        'appel cadre qui sert à définir le théme de la présentation de datas sur la feuille excel*
        'End If
 
          If Target.Address <> "" And Target.Address <> oldtarget Then
 
            comptechangement = comptechangement + 1
            If comptechangement > 1 Then CommandButton1.Caption = comptechangement & "  Pages ont été chargées sur :" & NBPAGES
            'ne se lance pas au 1° passage
            oldtarget = Target.Address 'initialisation de oldtarget au 1° passage:   : oldtarget : "$A:$G" : Variant/String
          End If
        End If 'ce End If va avec le If Target.Column <8 pour ne déclencher le compteur comptechangement que si column <8
 
        If comptechangement = NBPAGES + 1 Then 'ne se lance pas au 1° passage car comptechangement=1 et NBPAGES=0
            CommandButton1.Caption = "mise en place des tableaux Terminés  "
            MsgBox "operation comencée a : " & debut & vbCrLf & "elle c'est terminée a : " & Time & vbCrLf & "elle aura  durré : " & Format(Time - debut, "nn:ss")
            CommandButton1.Caption = "Telecharger les requetes "
            comptechangement = 0
            schplage = False
            Application.ScreenUpdating = True
        End If
    End If
End Sub

Puis Voici le code de la sub lancant la requête et celle créant le fichier vbs:

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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
 
Public comptechangement
Public NBPAGES As Long
Public debut
Public schplage As Boolean
Public oldtarget
 
Sub EURONEXT_ALL_EQUITIES()
    'cette sub va interroger le serveur pour récupérer toutes les données du jour
    'Il faut activer la bibliothèque Microsoft WinHTTP Service
    Dim i As Long, ARGTS_send As String, Fso As Object
    schplage = False 'voir code Feuil1
    NBPAGES = 0
    pageblanche 'appel sub pageblanche pour blanchir Feuil1, la sub pageblanche lance la private sub Worsheet_change    comptechangement = 0
 
    Application.ScreenUpdating = False
    Dim DemandeFichier As Object, URL As String
    Dim FSys As Object, MonFic
    Dim texte As String
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    URL = "https://euronext.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
    'On génère la 1 ere requête afin d'obtenir les 20  1ere ligne ainsi que le nombre de page
    DemandeFichier.Open "POST", URL, False
    DemandeFichier.setRequestHeader "x-requested-with", "XMLHttpRequest"
    DemandeFichier.setRequestHeader "Accept-Language", "fr"
    DemandeFichier.setRequestHeader "Referer", "https://europeanequities.nyx.com/fr/equities-directory"
    DemandeFichier.setRequestHeader "Accept", "application/json, text/javascript, */*"
    DemandeFichier.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
    DemandeFichier.setRequestHeader "Accept-Encoding", "gzip, deflate"
    DemandeFichier.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
    DemandeFichier.setRequestHeader "Host", "europeanequities.nyx.com"
    DemandeFichier.setRequestHeader "Content-Length", "231"  'Ajouté
    DemandeFichier.setRequestHeader "DNT", "1"
    DemandeFichier.setRequestHeader "Connection", "Keep - Alive"
    DemandeFichier.setRequestHeader "Cache-Control", "no-cache"
 
    'on envoie la requete avec un idisplaystart= a 0
    DemandeFichier.send "sEcho=5&iColumns=7&sColumns=&iDisplayStart=0&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"
 
   ' on détermine le nombre de page a télécharger en récupérant le iTotalRecords dans la première page et en divisant par 20
    NBPAGES = Round(Val(Split(Split(DemandeFichier.responseText, "iTotalRecords"":")(1), ",")(0)) / 20)
 
    'on a executer une requette presque pour rien me dira tu
    'mais il n'en est rien ,en fait la premiere requete est excecutée pour determiner le nombre de page
 
    'par contre ici toujours
    'suppression\création du répertoire response pour les fichiers DemandeFichier.responseText
    On Error Resume Next
    Kill ThisWorkbook.Path & "\response\*.*"
    RmDir ThisWorkbook.Path & "\response"
    MkDir ThisWorkbook.Path & "\response"
    On Error GoTo 0
 
    creationvbs2 'appelle la sub creationvbs2...c'est celle qui crée le ficheir vbs 
 
    requetevbs = ThisWorkbook.Path & "\requeteallequities.vbs"
    debut = Time
    SC = """" & requetevbs & """ "
    schplage = True 'pour enclencher si schplage = True le théme de la présentation des datas sur la feuille excel
    'le True n'existe qu'ici avant la récupération des datas par la requête
    For i = 0 To NBPAGES
        ARGsending = i * 20 '=WScript.Arguments(1)
        firstcel = i * 20 + 2 'il n'y a pas de saut de ligne sur l'affichage excel, =WScript.Arguments(2)
        '+2 pour débuter en 2° ligne car la 1° sert pour le command_button
        With CreateObject("WScript.Shell")
            .Run SC & URL & " " & ARGsending & " " & firstcel
        End With
    Next
End Sub
 
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                                   CREATION DU VBS UNIQUE
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
 
 
Sub creationvbs2()
'cette sub va écrire le texte des requêtes vbs (en fait toutes les requêtes sont écrites dans un seul fichier *.vbs
 
    Dim code As String, sending As String, Parser As String, FSys As Object, MonFic As Object 
 
    code = "dim tablo,tablo2(20,7)" & vbCrLf 
    code = code & "do" & vbCrLf
    code = code & "b=b+1" 'en place du rupteur b qui quitte si b=10
    code = code & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
    code = code & vbCrLf & "DemandeFichier.Open ""POST" & """, WScript.Arguments(0), False" & vbCrLf
 
    code = code & vbCrLf & "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Referer"", ""https://europeanequities.nyx.com/fr/equities-directory""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0""" & vbCrLf
 
    ARGTS_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=""" & "& WScript.Arguments(1) & " & """&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
 
    code = code & vbCrLf & "DemandeFichier.send " & ARGTS_send
 
    'ici ajout de if status = 200 pour être sûr que le script revient bien
   code = code & vbCrLf & "If DemandeFichier.status <>200 then MsgBox(""Pas de retour de connexion""):z =100 : MsgBox(""Quit n° "" & z):WScript.Quit 100"
   code = code & vbCrLf & "str_demande_fich = DemandeFichier.responseText"
 
   'test pour le dernier response vide
    'si la réponse à cette forme il s'agit du fichier de queue qui est vide...donc inutile de le garder oui mais
    'seulement dans ce cas il y a la perte du timer car dans Feuil1 il faut If comptechangement = NBPAGES + 1 Then
   code = code & vbCrLf & "if str_demande_fich= ""{""""sEcho"""":""""5"""",""""iTotalRecords"""":0,""""iTotalDisplayRecords"""":0,""""aaData"""":[],""""error"""":false}"" then "
    code = code & vbCrLf & "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""B"" & WScript.Arguments(2)) = """""
    'ici mise en retour d'un GetObject pour déclencher le compteur et donc le Timer, seulement cela va déclencher plage qui va déclencher cadre
    'donc affichage d'une cellule violette vide...mais pour éviter cela inscription en colonne B (=colonne 2) et mise en
    'code Feuil1 if Target.Column <>2 pour déclencehr le plage comme cela il n'y a plus de fond violet intempestif
    code = code & vbCrLf & "Ag= true"
    code = code & vbCrLf & "End If"
 
   'par précaution mettre un rupteur pour b par exemple 10
     code = code & vbCrLf & "If b>9 then"
 
     'si erreur elle est signalée par un rapport d'erreur en colonne i
     code = code & vbCrLf & "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""I""&(WScript.Arguments(1)/20)+6 ).Value=""page ""  & (WScript.Arguments(1)/20)+1 &"" = "" & b & ""  essai"""
     code = code & vbCrLf & "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Value = WScript.Arguments(1)/20"
     'pour afficher le n° du script défectueux dans la cellule en colonne A 
     'Par contre lors de la sortie par WScript.Quit le théme du fond d'écran n'est pas perdu puisqu'il y a bien GetObject qui va déclencher le plage dans la Feuil1
     code = code & vbCrLf & "WScript.Quit 1" 'WScript.Quit 1 marche mais 1 n'apaprait pas
     code = code & vbCrLf & "Exit Do" 'le WScript.Quit étant actif exit do ne sert plus à rien
     code = code & vbCrLf & "End If"
 
     'ici vérification avec la condition sur code
     code = code & vbCrLf & "Eg = instr(str_demande_fich, """"""error"""":true"")>0" '=> ""error"":true
     'code = code & vbCrLf & "Eg = instr(str_demande_fich, ""error"""":true}"")>0" '=> error"":true} version Pat
     code = code & vbCrLf & "Loop While instr(str_demande_fich, """"""error"""":true"")>0"
  'ici les syntaxes pour echo:true différent mais cela dit elle ne sont pas contradictoire il va falloir vérifier si elles
  'sont justes en regardant si dans les cellules du tableau de rapport il y a eu parfois des relances => valeur de b <> 1  'dans le tableau mais pas possible pour le moment car plus d'erreur de relance de retours des scripts!!!
 
     'ici ce message ne s'affiche plus si b=10 le Wscript.Quit a fait quitter le script=>
     code = code & vbCrLf & "If b=10 then MsgBox(""Script non quitté WScript.Quit 1 défectueux car pourtant instr= "" & Eg)"
 
        code = code & vbCrLf & "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "reponse = reponse & tablo2(Z, 0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 1)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 2)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 3)" & vbCrLf & _
             "tablo2(Z, 4) = Replace(Split(tablo(i), """""","""""")(3),"","",""."")" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 4)" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 6)" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "reponse = reponse & chr(9) & tablo2(Z, 5) & vbcrlf" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"
 
     code = code & vbCrLf & "reponse = reponse & vbcrlf & str_demande_fich" 'ici reponse à toutes les datas de tablo2
     '+ demandefichier.responsetext
 
     code = code & vbCrLf & "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""I""&(WScript.Arguments(1)/20)+6 ).Value=""page ""  & (WScript.Arguments(1)/20)+1 &"" = "" & b & ""  essai"""
    'pour l'affichage du tableau de rapport du nombre de relance
    'ici introduction de la condition Ag=False (pour ne pas afficher si il existe le fichier de queue des data
    code = code & vbCrLf & "If Ag = False Then"
    code = code & vbCrLf & "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Resize(UBound(tablo2), 7) = tablo2"
    'pour l'affichage des datas suite au retour des scripts
    code = code & vbCrLf & "End If"
 
     'pour enregistrer sous fichier response au format texte le retour des datas
      enreg = "Set FSys = CreateObject(""Scripting.FileSystemObject"")"
     enreg = enreg & vbCrLf & "Set MonFic = FSys.CreateTextFile(""C:\Users\...\response\response"" & WScript.Arguments(1)/20 & "".txt"")"
     enreg = enreg & vbCrLf & "With MonFic" & vbCrLf & ".write reponse" & vbCrLf & "End With"
 
    code = code & vbCrLf & enreg
 
      With ThisWorkbook
        'On copie le code dans un fichier
        Set FSys = CreateObject("Scripting.FileSystemObject")
        Set MonFic = FSys.CreateTextFile(.Path & "\requeteallequities" & ".vbs")
        With MonFic    'Pour écrire dans le fichier texte
            .write code
        End With
    End With
End Sub

**itwoo** · 28/02/2015, 11h02

Bonjour,

Encore quelques petites modifications pour le code du script vbs pour éviter des erreurs de présentation, format...il faut remplacer l'ancienne partie par celle ci:

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
code = code & vbCrLf & "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
             "tablo2(Z, 4) = Replace(tablo2(Z, 4),""."","""")" & vbCrLf & _
             "tablo2(Z, 4) = Replace(tablo2(Z, 4),"","",""."")" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "If instr(tablo2(Z, 1), "",null"")>0 then" & vbCrLf & _
             "tablo2(Z, 1) = split(tablo2(Z, 1),"""""",null"")(0)" & vbCrLf & _
             "tablo2(Z, 2) = ""-"":tablo2(Z, 3) =""-"":tablo2(Z, 4) =""-"":tablo2(Z, 5) =""-"":tablo2(Z, 6) = ""-""" & vbCrLf & _
             "End If" & vbCrLf & _
             "reponse = reponse & tablo2(Z, 0) & chr(9) & tablo2(Z, 1) & chr(9) & tablo2(Z, 2) & chr(9) & tablo2(Z, 3) & chr(9) & tablo2(Z, 4)& chr(9) & tablo2(Z, 5)& chr(9) & tablo2(Z, 6) & vbCrLf" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"

Voilà maintenant il ne devrait plus y avoir d'erreur

Pilotage Internet Explorer

Macros et VBA Excel

Discussions similaires

Partager

Partager