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
| Function recup_valeur(cel)
Dim trouvé As Boolean
Dim oHttP2 As Object, baseuRl, tablo(1, 2), groupeSPAN As Object, groupeTD As Object, uRl As String
trouvé = False
'uRl = "http://www.morningstar.fr/fr/funds/snapshot/snapshot.aspx?id=" & cel.Value '<-------- ancienne ligne v 1.02
uRl = cel.Hyperlinks(1).Address
Set oHttP2 = CreateObject("MSXML2.XMLHTTP")
oHttP2.Open "POST", uRl, False
oHttP2.send
With CreateObject("htmlfile")
.write oHttP2.responseText
Set groupeSPAN = .getElementsByTagName("SPAN")
Set groupeTD = .getElementsByTagName("TD")
For Each elem In groupeTD
'line text
If elem.classname = "line text" Then
If InStr(elem.innertext, "%") = 0 Then
tablo(1, 1) = Replace(Split(elem.innertext, " ")(1), ",", ".")
tablo(1, 2) = Split(elem.innertext, " ")(0)
cel.Offset(0, 5) = Replace(Replace(Replace(elem.ParentNode.Children(0).Children(0).innertext, vbCrLf, ""), "(", ""), ")", "")
trouvé = True
Exit For
End If
End If
Next
If trouvé = False Then
For Each elem In groupeSPAN
'price
If elem.classname = "price" Then
If InStr(elem.innertext, "$") > 0 Then
tablo(1, 1) = Replace(elem.innertext, "$", "")
ElseIf InStr(elem.innertext, "€") > 0 Then
tablo(1, 1) = Replace(elem.innertext, "€", "")
Else
tablo(1, 1) = elem.innertext
End If
Exit For
End If
Next
End If
End With
recup_valeur = tablo
End Function
'Fonction de recherche des liens morningstar en fonction des ISIN
Function Recup_link_Morningstar(cel As Range)
'Déclaration des variables
Dim oHttp As Object, mylink As Object, groupeTD As Object, uRl As String, i As LongPtr
'Requête HTTP
Set oHttp = CreateObject("MSXML2.XMLHTTP")
oHttp.Open "POST", "http://www.morningstar.fr/fr/funds/SecuritySearchResults.aspx?type=ALL&search=" & cel.Value, False
oHttp.send
With CreateObject("htmlfile")
.write oHttp.responseText
Set groupeTD = .getElementsByTagName("TD")
'Recherche de l'URL correspondant à l'ISIN
For i = 1 To groupeTD.Length - 1
If groupeTD(i).classname = "msDataText searchLink" Then Set mylink = groupeTD(i).Children(0): Exit For
Next
uRl = "http://www.morningstar.fr/" & Split(mylink.href, "about:")(1)
' cel.Offset(0, 1) = Split(mylink.href, "=")(1) ' ancien code version 1.02
cel.Hyperlinks.Add Anchor:=cel.Offset(0, 1), Address:=uRl, TextToDisplay:=Split(mylink.href, "=")(1)
End With
Range(Cells(cel.Row, 6), Cells(cel.Row, 7)) = recup_valeur(Cells(cel.Row, 4))
reg = True
End Function |
Envoyé par patricktoulon
).
Répondre avec citation
: ça peut servir aux autres 
. 
Partager