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 Refresh()
'Tested using IE7, Excel 2000 SP1, and Windows XP
'Nécessite d'activer les références:
'Microsoft HTML Objects Library
Dim j As Integer
Dim objIE As Object
Dim htmlDoc As Variant
Dim F As Integer
Dim Adres As Variant
Dim Mnemo As String
Dim i As Double
Dim Cours As Variant
Dim Pourc As Variant
Dim ItemCours As String
Dim ItemPourc As String
Dim A As Variant
Dim m As Integer
Dim EnCours As Range
Dim Lamin As String
For j = 1 To 45
If Cells(j + 12, 3) <> "" Then
Cells(j + 12, 1) = "En cours..."
Set Adres = Cells(j + 12, 6)
Mnemo = Cells(j + 12, 3)
Flag0:
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.AddressBar = False
.StatusBar = False
.MenuBar = False
.Toolbar = 0
.Visible = False
.navigate Adres.Value
End With
While objIE.Busy
Wend
While objIE.document.readyState <> "complete"
Wend
Set htmlDoc = objIE.document
'Cibler les deux items qui nous intéressent
ItemCours = 0
ItemPourc = 0
Flag1:
For i = 580 To 620
If InStr(1, htmlDoc.all.Item(i).innertext, "EUR") > 0 Then
If Len(htmlDoc.all.Item(i).innertext) < 12 And IsNumeric(Left(htmlDoc.all.Item(i).innertext, 3)) = True Then
ItemCours = htmlDoc.all.Item(i).innertext
If IsNumeric(Left(ItemCours, 3)) = False Then
GoTo Flag0:
End If
GoTo Flag2:
End If
End If
Next
Flag2:
For m = i + 1 To 620
If InStr(1, htmlDoc.all.Item(m).innertext, "%") > 0 Then
On Error GoTo Flag3:
If Len(htmlDoc.all.Item(m).innertext) < 9 And IsNumeric(Left(htmlDoc.all.Item(m).innertext, 3)) = True Then
ItemPourc = htmlDoc.all.Item(m).innertext
GoTo Flag4:
End If
End If
Flag3:
Next
Flag4:
'Extraire les données numériques des deux items
A = 0
A = Split(ItemCours, "EUR")
Cours = CDbl(A(0))
If Cours = 0 Then
GoTo Flag0:
End If
A = 0
A = Split(ItemPourc, " %")
Pourc = CDbl(A(0)) / 100
Cells(j + 12, 4) = Cours
Cells(j + 12, 5) = Pourc
End If
Cells(j + 12, 1) = ""
Set objIE = Nothing
Next
If Minute(Time) < 10 Then
Lamin = "0" & Minute(Time)
Else: Lamin = Minute(Time)
End If
Range("heure") = Hour(Time) & " h " & Lamin
Range("Ladate") = Date
End Sub |
Partager