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
| Option Explicit
Dim oWbk As Excel.Workbook
Dim v1 As Variant, v2 As Variant, vT As Variant '1 = valeur 1; 2 = valeur2; T = les 2 valeurs
Dim i1 As Long, i2 As Long, iT As Long, j As Integer
Dim oSh As Excel.Worksheet, oRng As Excel.Range
Const csSheetName As String = "Tables"
Dim OK As CommandButton
Dim compte_titre As Double
Sub poletIV()
MsgBox ("Veuillez vous connecter à internet")
Denis
OK_Click
End Sub
Sub Affiche_titre()
compte_titre = 0
On Error GoTo lblErreur1
If Titres.UBS.Value = True Then
compte_titre = compte_titre + 1
Set oWbk = Application.Workbooks.Open("http://ichart.finance.yahoo.com/table.csv?s=UBSN.VX&d=3&e=28&f=2011&g=d&a=6&b=10&c=2006&ignore=.csv")
End If
On Error GoTo 0
v1 = oWbk.Worksheets(1).UsedRange.Value
oWbk.Close False
On Error GoTo lblErreur2
If Titres.Nes.Value = True Then
compte_titre = compte_titre + 1
Set oWbk = Application.Workbooks.Open("http://ichart.finance.yahoo.com/table.csv?s=NESN.VX&d=4&e=3&f=2011&g=d&a=5&b=25&c=2001&ignore=.csv")
'lien pour le SMI
'Set oWbk = Application.Workbooks.Open("http://ichart.finance.yahoo.com/table.csv?s=%5ESSMI&d=3&e=30&f=2011&g=d&a=10&b=9&c=1990&ignore=.csv")
End If
On Error GoTo 0
v2 = oWbk.Worksheets(1).UsedRange.Value
oWbk.Close False
If compte_titre = 0 Then
MsgBox ("Veuillez reprendre la saisie en cochant au moins un titre. Merci!")
Exit Sub
End If
's'assurer d'une feuille "Tables"
On Error Resume Next
Set oSh = ThisWorkbook.Worksheets(csSheetName)
On Error GoTo 0
If oSh Is Nothing Then
ThisWorkbook.Worksheets.Add , ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set oSh = ActiveSheet
oSh.Name = csSheetName
Else
oSh.UsedRange.Delete
End If
Set oRng = oSh.Range("A1:O" & UBound(v1, 1) + UBound(v2, 1) - 1)
vT = oRng.Value
'renseigner la ligne des titres
For j = 1 To 7
vT(1, j) = v1(1, j)
vT(1, j + 8) = v2(1, j)
Next j
i1 = 2
i2 = 2
iT = 2
While (i1 <= UBound(v1, 1)) And (i2 <= UBound(v2, 1))
'synchroniser v1 et v2
While v1(i1, 1) <> v2(i2, 1)
If v1(i1, 1) > v2(i2, 1) Then
i1 = i1 + 1
Else
i2 = i2 + 1
End If
Wend
'écriture v1 et v2
For j = 1 To 7
vT(iT, j) = v1(i1, j)
vT(iT, j + 8) = v2(i2, j)
Next j
i1 = i1 + 1
i2 = i2 + 1
iT = iT + 1
Wend
oRng.Value = vT
lblSortie:
Set oRng = Nothing
Set oSh = Nothing
Set oWbk = Nothing
v1 = Empty
v2 = Empty
vT = Empty
Exit Sub
lblErreur1:
MsgBox "Une erreur s'est produite lors du premier chargement. Abandon."
GoTo lblSortie
lblErreur2:
MsgBox "Une erreur s'est produite lors du deuxième chargement. Abandon."
GoTo lblSortie
End Sub
Sub Denis()
Titres.Show
End Sub
Sub OK_Click()
If OK.Caption = "OK" Then
MsgBox ("Activée")
Else
MsgBox ("nonactivée")
End If
End Sub |
