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
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
| Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Generic As HTMLGenericElement
'Dim Generic_TBody As IHTMLElementCollection
Dim Generic_TBody As HTMLTableSection
Dim LienViewData As HTMLAnchorElement
Dim InputDateTexte As HTMLInputElement
Dim Bouton As HTMLButtonElement
Dim FormatChargement As IHTMLInputElement
Dim ag As Boolean, bg As Boolean, cg As Boolean
Dim da1 As Date, db1 As Date, db2 As Date, date_chargee As Date
Dim nbreanchor As Integer, intrep As Integer
Dim b As Integer, f As Integer, h As Integer, i As Integer, j As Integer, r As Integer
Dim chaine As String, entete As String, ligne1 As String, lignetest As String, fl_shc As String
Dim mot As String, reper As String, string_date As String
Dim u() As String, eu() As String
Dim differ() As Variant
Global k As Integer
Global separateur() As Variant
Global supprim() As Variant
Global lign_supprim() As Variant
Public Sub WaitIE(IE As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargée
Do Until IE.Busy = False And IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
End Sub
Sub wait_Secondes(SEC)
SEC = Format(SEC, "00")
Application.Wait (Now + TimeValue("0:00:" & SEC))
End Sub
'vider les temporaires
Sub Clear_Temp_Files()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1"
End Sub
Sub euronextpage1()
Dim nombre, nbre, ligne
Columns("A:J") = ""
[A1].Select
Dim mydata, fich, pag
'cette sub pour récupérer les données historiques
'ici l'exemple traité par défaut est AIR LIQUIDE (FR0000120073)
IE.Navigate "https://europeanequities.nyx.com/en/products/equities/FR0000120073-XPAR/quotes"
IE.Visible = True
WaitIE IE
Set IEDoc = IE.document
Set LienViewData = IEDoc.all("tablesNavigation_hi") 'pour aller directement au tableau historique
LienViewData.Click 'On exécute le lien
db1 = "02/01/2012"
Set InputDateTexte = IEDoc.all("historicalDatePicker1") 'ici avec id pointe directement sur le bon input!!!
InputDateTexte.Value = db1 'On inscrit le texte dans l'input soit la date de début
db2 = "15/09/2013"
Set InputDateTexte = IEDoc.all("historicalDatePicker2") 'ici avec id pointe directement sur le bon input!!!
InputDateTexte.Value = db2 'On inscrit le texte dans l'input soit la date de fin
'il faut ensuite cliquer sur le bouton dont id="refreshHistoricalPC" type="button" value="Refresh
z10: 'on boucle ici pour relancer
a = 0 'pour réinitialiser a si jamais relance
Set Bouton = IEDoc.getElementById("refreshHistoricalPC")
Bouton.Click
'Attention le click sur le bouton refresh ne marche pas à 100% (lorsuq'il ne marche pas comme il faut
'cela peut se détecter visuelleemnt car sur la page web à l'écran il ne s'affiche pas dasn le tableau des
'dates, la date téléchargée demandée (13/09/2013 ici) la plus récente mais une autre date ou même rien
'même si l'on n'a pas besoin d'attendre l'affichage de la page pour récupérer les datas si jamais il y a un probléme
'c'est un moyen visuel de le détecter
'le Tableau et plein de chose utile pour la suite sont dans les div
Set divelements = IEDoc.getElementsByTagName("div")
'on boucle jusqu'a que la bonne classe apparaisse dans les divelements
' et comme il y en a plusieur de la meme classe on recupere que celui qui a le (turnover) dans son code
'**************************************************************************************************************************
'ICI ON VA RECUPERER LE NOMBRE DE PAGE A VISTER EN DIVISANT LE NOMBRE DE JOUR QUE L'ON RECUPERE EN DESSOUS DU TABLEAU
'EXEMPLE : Total Number of Days: 886
Do
Set nbligne = IEDoc.all("historicalTable_info")
nombre = Fix(Split(nbligne.innerText, ":")(1) / 50) + 1
Loop While nombre < 2 'attention ici suppose plus de 50 cotations il faut surveiller cela
'***************************************************************************************************************************
Do
e = e + 1
If e = divelements.Length Then e = 1
Loop Until divelements(e).className = "dataTables_scroll" And InStr(divelements(e).outerHTML, "Turnover") > 0
'on boucle tant que loading est present dans le outerhtml de l'element
b = e 'b= n° e recherché
'j = 0 'j est le compteur des lignes de data TR
'ReDim u(3000) 'pour dimensionner u() pour récupérer les TR de data pas plus de 3000 lignes (52*5*10 ans)
Do
a = a + 1
'a c'est le compteur pour charger toutes les pages une par une...
Do: Loop While InStr(divelements(b).outerHTML, "Loading") > 0 'cette boucle n'est pas suffisante
Set Generic = divelements(b) 'generic va permettre d'analyser l'élement e=584
'il va aussi permettre de récupérer toutes les datas sous format texte
'MsgBox ("Voici divelements(584).outerHTML =" & divelements(584).outerHTML)
'objectif récupérer la 1° date téléchargée dans le tableau...
'cette date se trouve être <td class="rt sorting_1">13/09/2013</td> donc il faut spliter jsute avant et
'aprés pour isoler 13/09/2013
chaine = divelements(b).outerHTML
If aig = False Then 'au 1° passage pour vérifier si date est la bonne
Do
chaine = divelements(b).outerHTML
string_date = Split(chaine, "<td class=""rt sorting_1"">")(1)
'MsgBox ("chaine " & chaine)
string_date = Split(string_date, "</td>")(0)
date_chargee = string_date
If db2 - date_chargee > 5 Then
'ici relance du click sur le bouton refresh relance le processus mais pas chaine...pourquoi?
'Set Bouton = IEDoc.getElementById("refreshHistoricalPC")
'Bouton.Click
GoTo z10 'pour relancer le processus
End If
Loop While (db2 - date_chargee > 5) 'boucle tant que plus de 5 jours d'écarts
aig = True
End If
ligne = Split(chaine, "</table>") 'table doit servir de séparateur pour garder un bon affichage des datas
'ici au 1° passage récupération de l'entête
If a = 1 Then
entete = ligne(0)
Range("A1").Select
'pour envoyer dans le presse papier les éléments de l'entête
Set mydata = New DataObject
'mydata.SetText divelements(b).outerHTML
mydata.SetText ligne(0)
'mydata.SetText divelements(b).innerText non ne marche pas
mydata.PutInClipboard
'on envoie les éléments de l'entête du tableau dans la feuille excel
Set fich = ThisWorkbook
Set pag = fich.Sheets(1)
pag.Paste
End If
'ici ligne(1) à sa 1° ligne qui est vide à supprimer mais cette ligne s'affiche correctement...
'ainsi que toutes les datas...
'1° idée supprimer le thead de ligne(1) ca marche!!!
ligne1 = Split(ligne(1), "<thead>")(0) & Split(ligne(1), "</thead>")(1)
'on repere la premiere ligne libre de la feuille
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
ancientexte = divelements(b).outerHTML
Set mydata = New DataObject
mydata.SetText ligne1
mydata.PutInClipboard
'*****************************************************************************************************************************
'on envoie la page1 du tableau dans la feuille
Set fich = ThisWorkbook
Set pag = fich.Sheets(1)
pag.Paste
repart: ' introduit repart: a quoi sert ce repart:(a rien ici??? est ce pour aller avec un ancien goto disparu???)
Set boutonpagenext = IEDoc.all("historicalTable_next")
'c'est le bouton pour aller à la page suivante
boutonpagenext.Click
'attention lorsque l'on arrive ici e = 584 déjà supérieur à 100 donc la condition pour sortir de la boucle jamais remplie...
e = 1 'pour réinitialiser e
Do
If divelements(b).outerHTML <> ancientexte Then Sort = True
'ancienne boucle d'attente de Patrick???
e = e + 1
If e = 100 Then Sort = True
Loop Until Sort = True
Loop Until a = nombre
nombre = 0
IE.Quit
Set IE = Nothing
Set IEDoc = Nothing
End Sub |
.
Tutoriel : 
Répondre avec citation
: ça peut servir aux autres 
Envoyé par itwoo
c'est moins fun mais bon suis à jour comme ca avec vous...c'est l"essentiel ca ne retarde plus 
Partager