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 |
Partager