téléchargement des cours / des codes reuters-sico-isin...

Zone d'échange de sources C, C++, Java, VB, VBA et autres...

Modérateur : webmaster

Invité

téléchargement des cours / des codes reuters-sico-isin...

Message par Invité » 12/09/2003 19:06

Bonjour,

Je cherche à me construire une petite base de données personnelle, qui téléchargerait automatiquement les cours.
Malheureusement, je n'ai pas trouvé beaucoup de sites qui permettent de télécharger les cours de manière aisée (il faut que les parametres soient dans l'adresse html), hormis yahoo.

D'où plusieurs questions:
* sur ton site, tu as une transcodification entre reuters et sico/isin/mnemonique. Où trouves-tu l'information? sur quels sites/quelles adresses?
* en ce qui concerne tes archives, quelle est ta source?

Merci pour les infos, pour ton super site, et j'espère que ces questions pourront aider d'autres personnes qui se posent le meme genre de questions.

Avatar du membre
webmaster
Messages : 775
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 13/09/2003 03:01

Bonsoir,

Le fichier de conversion de codes Sicovam/ISIN/Mnémoniques est issu du convertisseur fourni par Euronext ISINConverter.exe.

Pour récupérer la table, voici comment faire (extrait d'un message posté par mes soins sur un autre forum) :
ISINConverter.exe est une applet java packagée dans un auto-extractible. Quand on lance l'exécutable, il décompresse son contenu dans un répertoire temporaire. On retrouve donc dans ce répertoire temporaire un certain nombre de fichiers : le disclaimer en français et en anglais, la page html affichée ensuite, en français et en anglais, et une archive java :
converterApplet.jar. Celle-ci contient en gros le code java de l'applet de conversion, mais aussi et surtout un joli petit fichier conv_isin.csv.

Le fichier en question contient 9701 valeurs (Sico, Mnémonique, ISIN, Libellé, Code de négociation Euronext et la place de cotation).

Normalement, ce fichier doit être récupérable unitairement sur le site d'Euronext (ça m'a été confirmé par l'Equipe Internet d'Euroclear, qui dispose du fichier, le propose à ses membres et qui a bien sûr soigneusement évité de me l'envoyer et de m'indiquer l'URL exacte où on peut le trouver sur le site d'Euronext). Sur le site d'Euronext, j'ai trouvé aussi un PDF contenant la même chose, mais pas sympa à utiliser le pdf. J'ai renoncé à demander l'url du .csv à Euronext car ils mettent des mois à répondre aux mails et s'arrangent presque toujours pour répondre à côté de la question ! De toute manière ça doit être exactement le même.

Bref, pour récupérer le fichier conv_isin.csv, il suffit de :
- lancer ISINConverter.exe ;
- noter l'url (adresse) affichée dans le navigateur (là où on tappe l'adresse d'un site d'habitude) ;
- aller voir dans le répertoire indiqué ( Sous XP par exemple, c'est en général sous C:\Documents and Settings\[Utilisateur.Machine]\Local Settings\Temp\), on y trouve l'archive converterApplet.jar ;
- ouvrir le .jar (c'est un .zip en fait), vous trouverez dans sa racine le fameux fichier conv_isin.csv.
Sinon, le convertisseur SicoIsin (écrit par votre serviteur) posséde ses propres fonctions pour créer un code ISIN depuis un code Sicovam et inversement, fonctions implémentées à partir de documents également disponibles sur le site d'Euronext.

Concernant le fichier de codes Sicovam/ISIN/Bloomberg/Datastream/Mnémonique, il est constitué par récupération des pages individuelles de toutes les valeurs sur le site d'Euronext et extraction des codes sur chaque page.

Enfin, pour ce qui est des archives de cours, les sources sont multiples : je télécharge les cours tous les soirs, soit sur Euronext, soit sur des sites de courtiers ou sur des sites généralistes. Il m'est arrivé d'en télécharger plusieurs et de les comparer : en général, ils étaient identiques.

Pour ce qui est de la récupération de cours de valeurs unitaires, l'idéal serait de pouvoir interroger un webservice plutôt que d'avoir à récupérer du html et à le déshabiller pour en extraire le cours. J'avais cherché il y a quelques temps mais sans succès. Les webservices existant sont payants ou ne servent pas les valeurs françaises. Mais je pense qu'on devrait pouvoir en trouver bientôt.

Sinon, sur la majorité des sites, les pages permettant de récupérer les infos liées à une valeur (y compris le cours), sont accédées via un GET http, ce qui veut dire que les paramètres peuvent être mis directement dans l'url. Rares sont les sites qui utilisent des POST http pour passer leurs paramètres. De plus, ceux utilisant des POST acceptent souvent les GET aussi, au moins si les pages sont générées par des servlets Java car la méthode doPost() de la servlet est souvent mappée sur la méthode doGet() ou inversement ! Idem pour ceux qui utilisent du php version 3 pour d'autres raisons, mais peu importe.

Au hasard : Donc, on a l'embarras du choix... non ?

Webmaster

Invité

Message par Invité » 13/09/2003 22:40

Excellent! Merci beaucoup pour ta réponse!!! :D

Renard du désert

Reccupération cours des valeurs du CAC40 dans Excel

Message par Renard du désert » 16/09/2003 21:40

Bonjour,

Savez vous aller chercher automatiquement dans une feuille Excel le cours d'une valeur ?

D'avance merci

Cyber PAPY
Messages : 90
Enregistré le : 02/07/2003 10:32
Contact :

importation sous XL

Message par Cyber PAPY » 16/09/2003 23:16

Bonsoir
Pour incorporer les cours dans une feuille Excel, il y a une macro en freeware sur le site de XL download
http://www.excel-downloads.com/html/Fre ... otationsXL


J'avais écrit plein de trucs à ce sujet , mais mon message précédent a disparu avant que je ne le poste.
Comme il se fait tard, j'en resterais là pour ce soir

Bonne Nuit

Cyber PAPY

Avatar du membre
webmaster
Messages : 775
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 17/09/2003 19:47

Bonjour,

Tiens, je vais aller voir, car du coup, suite à ce message, je viens d'en écrire une !!!

On aime vraiment réinventer la roue :lol:.

Pas grave, je l'ajouterai dans les archives, et au moins, je sais ce qu'elle fait.

ATTENTION : mon antivirus a détecté un virus (097M/HalfCross) dans la feuille CotationsXL.xla en question.

Webmaster

Renard du désert

importer les cours sous Excel

Message par Renard du désert » 17/09/2003 21:30

Merci pour cette addresse plein de fichiers utils (j'ai noté la feuille de paye d'une assistante maternelle sur laquel j'avais passé une bonne soirée :( )

Je vais l'importer demain au travail pour éviter les virus et me renvoyer le fichier par mail (pas d'antivirus à la maison)

Encore merci pour ce site et ce forum.

PS : Si cela peut etre utile à quelqu'un, j'ai créé un fichier Excel qui permet de suivre un portefeuille de type PEA

Avatar du membre
webmaster
Messages : 775
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 17/09/2003 22:03

Bonsoir,

Bon, impossible d'utiliser CotationsXL. Pourtant ça a l'air intéressant. En dumpant le fichier on voit des choses chouettes, mais rien sous Excel !

Si quelqu'un a le fichier sans virus...

En attendant, je vous propose la petite macro réalisée par mes soins suite à ce thread.

En fait il y a une macro et une fonction. La macro permet de récupérer les cours de tous les titres des différents marchés sur le site d'Euronext. Elle effectue cinq GET HTTP sur le site d'Euronext, puis crée une feuille 'Valeurs' dans le classeur courant, feuille contenant les valeurs ainsi récupérées.

Ensuite, la fonction 'getCoursValeur("Code ISIN")' permet de récupérer le cours de cloture d'une valeur depuis une autre feuille en faisant par exemple :

Code : Tout sélectionner

=getCoursValeur("FR0000120404")
pour récupérer le cours d'Accor.

ATTENTION : je suis très très loin d'être un expert Excel ou VBA, mon domaine de prédilection étant plutôt le C ou l'assembleur, les exemples de code ci-dessous ne sont sûrement pas les plus beaux ou les mieux intégrés que l'on puisse trouver. M'enfin ils marchent. Et avec quelques échanges, on doit pouvoir les améliorer.

J'ai testé il y a quelques temps les requêtes WEB d'Excel, mais je n'ai jamais réussi à les faire fonctionner correctement. Du moins, leur résultat est souvent pour le moins inatendu ! Donc, je me suis orienté plutôt vers l'utilisation de la librairie Wininet gracieusement fournie par Microsoft. Celle-ci permet de récupérer des pages WEB avec un minimum de code. Les avantages de cette méthode sont multiples : rapidité, simplicité, compatibilité (ça doit marcher avec OpenOffice par exemple), etc.

Par contre, comme je suis un nain d'Excel, le code VBA en question devra être collé manuellement dans un module vba du classeur Excel que vous utilisez, en faisant :
1) ALT + F11
2) Dans la fenêtre "Projet - VBAProject" en haut à gauche, clic droit sur le nom du classeur, puis "Insertion", puis "Module"
3) Ouvrir le module inséré (en général "Module1", sous "Modules")
4) Coller le code suivant dedans :

Code : Tout sélectionner

'******************************************************************************
'*                                 Module Cours                               *
'******************************************************************************
'*                                                                            *
'* DESCRIPTION. : Ensemble de macros et fonctions permettant de recuperer des *
'*               cours de valeurs mobilieres sur Internet.                    *
'*                                                                            *
'* AUTEUR...... : webmaster 'La Bourse pour les nains'                        *
'*                http://www.bnains.org/                                      *
'*                                                                            *
'* VERSION..... : 0.1                                                         *
'*                                                                            *
'* ENVIRONNEMENT: Win32. Necessite Wininet. Compatible Excel et OpenOffice (a *
'*                verifier).                                                  *
'*                                                                            *
'* MACROS EXPORTEES :                                                         *
'*   telechargeCours = provoque la creation d'une feuille 'valeurs' a la fin  *
'*                     du classeur courant et y colle les cours des valeurs   *
'*                     de cinq marches, telecharges depuis le site d'Euronext *
'*                                                                            *
'* FONCTIONS EXPORTEES :                                                      *
'*   getCoursValeur ( szCodeISIN ) = renvoie le cours de cloture de la valeur *
'*                                   dont le code ISIN est passe en parametre.*
'*                                                                            *
'******************************************************************************
'* MODIFIE LE : ../../.... PAR ...............                                *
'* DESCRIPTION DE LA MODIFICATION :                                           *
'*                                                                            *
'******************************************************************************

Option Explicit
'==============================================================================
' Import
'==============================================================================
Public Declare Function InternetOpenA Lib "wininet" _
    (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
    
Public Declare Function InternetCloseHandle Lib "wininet" _
    (ByVal hInet As Long) As Integer
    
Public Declare Function InternetOpenUrlA Lib "wininet" _
    (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
    
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Declare Function InternetReadFile Lib "wininet" _
    (ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

'==============================================================================
' Déclarations de constantes
'==============================================================================
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_FLAG_RELOAD = &H80000000

Public Const COLONNE_COURS_CLOTURE = 3
Public Const COLONNE_CODE_ISIN = 1


'******************************************************************************
'*                         Macro telechargerCours                             *
'******************************************************************************
'*                                                                            *
'* Description : cette macro cree une feuille 'Valeurs' a la fin du classeur  *
'*               courant, puis recupere les cours de differents marches.      *
'*                                                                            *
'******************************************************************************
Sub telechargeCours()
' ----- On efface le contenu de la feuille des valeurs -----
Dim bValeurs As Boolean
Dim i As Integer
Dim s As Worksheet

bValeurs = False
For i = 1 To Sheets.Count
  If (Sheets(i).Name = "Valeurs") Then
    bValeurs = True
  End If
Next i

  Application.DisplayAlerts = False
If (bValeurs = True) Then
  Worksheets("Valeurs").Delete
End If
Set s = Sheets.Add(After:=Worksheets(Worksheets.Count))
s.Name = "Valeurs"
Application.DisplayAlerts = True

' Premier marché
recupereCours ("http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&market=10&cotation=0&lang=fr")
' Second marché
recupereCours ("http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&market=11&cotation=0&lang=fr")
' Nouveau marché
recupereCours ("http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&market=12&cotation=0&lang=fr")
' Marché libre
recupereCours ("http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&market=13&cotation=0&lang=fr")
' Trackers
recupereCours ("http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&market=50&cotation=0&lang=fr")
End Sub


'******************************************************************************
'*                         Fonction recupereCours                             *
'******************************************************************************
'*                                                                            *
'* Description : cette fonction recupere une page sur Internet et recopie son *
'*               contenu ligne par ligne dans la feuille 'valeurs' du classeur*
'*               courant.                                                     *
'*                                                                            *
'* Entree : URL des donnees a recuperer.                                      *
'*                                                                            *
'* Sortie : ajout de lignes dans la feuille 'Valeurs' du classeur.            *
'*                                                                            *
'* Retour : neant.                                                            *
'*                                                                            *
'******************************************************************************
Function recupereCours(szUrl As String)
  Dim hInternetSession As Long     ' handle de la session internet
  Dim hPage As Long                ' handle de la page

  '------ On ouvre une connexion -----
  hInternetSession = InternetOpenA("Wininet", 1, vbNullString, vbNullString, 0)
  If &#40;hInternetSession <> 0&#41; Then
    ' ----- On ouvre la page demandee -----
    hPage = InternetOpenUrlA&#40;hInternetSession, szUrl, vbNullString, 0, _
                             INTERNET_FLAG_RELOAD, 0&#41;
    If &#40;hPage <> 0&#41; Then
      Dim szBuffer As String * 32768   ' Buffer pour lecture de la page
      Dim lNbOctLus As Long            ' Pour recevoir le nombre d'octets lus
      Dim bRet As Boolean              ' Pour le code de retour de la lecture
      Dim iLigne As Integer
      Dim iColonne As Integer
      
      ' ----- On cherche la premiere ligne vide -----
      iLigne = 1
      iColonne = 1
      While &#40;Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, iColonne&#41;.Value <> ""&#41;
        iLigne = iLigne + 1
      Wend
      
      ' ----- On lit le contenu de la page -----
      'szLigne = String&#40;20480, 0&#41;
      Do
        szBuffer = vbNullString
        bRet = InternetReadFile&#40;hPage, szBuffer, Len&#40;szBuffer&#41;, lNbOctLus&#41;
        If &#40;bRet <> False And lNbOctLus <> 0&#41; Then
          ' On decoupe les lignes
          Dim iDebLigne As Integer
          iDebLigne = 1
          
          While &#40;InStr&#40;iDebLigne, szBuffer, Chr$&#40;13&#41;&#41; <> 0&#41;
            Dim szLigne As String
            Dim iFinLigne As Integer
            
            ' On recupere la ligne
            iFinLigne = InStr&#40;iDebLigne, szBuffer, Chr$&#40;13&#41;&#41;
            szLigne = Mid$&#40;szBuffer, iDebLigne, iFinLigne - iDebLigne&#41;
            
            ' On decoupe les infos a l'interieur de la ligne
            Dim iDeb As Integer
            Dim iDeb1 As Integer
            Dim szV As String
            Dim szV1 As String
            
            iDeb = 1
            While &#40;InStr&#40;iDeb, szLigne, Chr$&#40;9&#41;&#41; <> 0&#41;
              iDeb1 = InStr&#40;iDeb, szLigne, Chr$&#40;9&#41;&#41;
              ' On va ecrire la ligne lue dans la feuille reservee aux cours
              szV = Mid$&#40;szLigne, iDeb, iDeb1 - iDeb&#41;
              szV1 = nettoieChaine&#40;szV&#41;
              Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, iColonne&#41;.Value = szV1
              iColonne = iColonne + 1
              iDeb = iDeb1 + 1
            Wend
            iColonne = 1
            iLigne = iLigne + 1
            iDebLigne = iFinLigne + 1
          Wend
        End If
      Loop While &#40;bRet = True And lNbOctLus <> 0&#41;
      
      ' ----- On ferme le handle de la page -----
      CloseHandle &#40;hPage&#41;
    End If
    ' ----- On ferme la connexion -----
    InternetCloseHandle &#40;hInternetSession&#41;
  End If

End Function


'******************************************************************************
'*                         Fonction getCoursValeur                            *
'******************************************************************************
'*                                                                            *
'* Description &#58; cette fonction renvoie le cours de cloture d'une valeur en   *
'*               fonction de son code ISIN. Pour ce faire, elle cherche la    *
'*               valeur dans la feuille 'Valeurs' du classeur courant.        *
'*                                                                            *
'* Entree &#58; szCodeISIN = code ISIN de la valeur dont on souhaite connaitre le *
'*                       cours de cloture.                                    *
'*                                                                            *
'* Sortie &#58; Neant.                                                            *
'*                                                                            *
'* Retour &#58; cours de cloture ou '?' si valeur non trouvee.                    *
'*                                                                            *
'******************************************************************************
Function getCoursValeur&#40;szCodeISIN As String&#41; As String
' On cherche le code dans la feuille 'Valeurs'
Dim iLigne As Integer

iLigne = 1
While &#40;Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_CODE_ISIN&#41;.Value <> "" And _
        Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_CODE_ISIN&#41;.Value <> szCodeISIN&#41;
  iLigne = iLigne + 1
Wend

If Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_CODE_ISIN&#41;.Value = "" Then
  getCoursValeur = "?"
  Exit Function
End If

getCoursValeur = Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_COURS_CLOTURE&#41;.Value

End Function


'******************************************************************************
'*                         Fonction nettoieChaine                             *
'******************************************************************************
'*                                                                            *
'* Description &#58; cette fonction supprime les CR, LF et espaces en début et    *
'*               fin de chaine de caracteres.                                 *
'*                                                                            *
'* Entree &#58; szChaine = chaine a nettoyer.                                     *
'*                                                                            *
'* Sortie &#58; Neant.                                                            *
'*                                                                            *
'* Retour &#58; chaine nettoyee.                                                  *
'*                                                                            *
'******************************************************************************
Function nettoieChaine&#40;ByVal szChaine As String&#41; As Variant
Dim iDeb As Integer

'On nettoie le début
While Left$&#40;szChaine, 1&#41; = Chr$&#40;10&#41; Or Left$&#40;szChaine, 1&#41; = Chr$&#40;13&#41; Or Left$&#40;szChaine, 1&#41; = Chr$&#40;32&#41;
  szChaine = Right$&#40;szChaine, Len&#40;szChaine&#41; - 1&#41;
Wend
'On nettoie la fin
While Right$&#40;szChaine, 1&#41; = Chr$&#40;10&#41; Or Right$&#40;szChaine, 1&#41; = Chr$&#40;13&#41; Or Right$&#40;szChaine, 1&#41; = Chr$&#40;32&#41;
  szChaine = Right$&#40;szChaine, Len&#40;szChaine&#41; - 1&#41;
Wend
nettoieChaine = szChaine
End Function
Voilà, il suffit maintenant d'enregistrer le tout et vous pouvez fermer l'éditeur VBA.

Dans votre classeur Excel, faites "Outils/Macro/Macros...", sélectionnez "telechargeCours" et cliquez sur le bouton "Exécuter". Selon votre connexion internet et l'état du serveur Euronext, cela peut durer une ou deux minutes, voire davantage. Ne vous inquiétez pas, il suffit d'attendre...

A la fin, une feuille nommée 'Valeurs' est ajoutée (ou remplacée) à la fin de votre classeur. Elle contient environ 1200 valeurs avec leurs code ISIN, libellé, cloture, variation, ouverture, plus haut et plus bas.

Dans n'importe quelle autre feuille du classeur, il suffit pour obtenir un cours de cloture d'appeler la fonction getCoursValeur () en lui passant le code ISIN de la valeur recherchée en paramètre. Il est inutile d'être connecté pour cette phase là car la fonction getCoursValeur va chercher dans la feuille 'Valeurs' créée lors du téléchargement.

Il ne reste plus qu'à mettre le code dans un classeur .xla pour pouvoir l'exploiter sans avoir à dupliquer le code dans chaque classeur et à enrichir la chose d'autres fonctions.

J'allais oublier : comme Excel ne recalcule les formules par défaut que lors de l'ouverture du classeur ou de la modification d'une référence, il ne le fait pas lorsque l'on relance la macro telechargeCours. Donc, pour que toutes les cellules contenantd des "=getCoursValeur("Code_ISIN")" soient remises à jour, il suffit de forcer un recalcul général de la feuille via CTRL-ALT-F9.

Webmaster

Cyber PAPY
Messages : 90
Enregistré le : 02/07/2003 10:32
Contact :

le code de la macro:

Message par Cyber PAPY » 18/09/2003 02:27

la macro est un peu longue:
'Macro crée par Frederic Sigonneau
'http://perso.wanadoo.fr/frederic.sigonneau
Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As _
Boolean
Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, _
ByVal lpLCData As String, ByVal cchData As Long) As Long
'renvoie le séparateur de millier du système
Function SysSepMil() As String
Dim Sep As String * 2
GetLocaleInfo 0, &HF, Sep, 2
SysSepMil = Left$(Sep, 1)
If SysSepMil = "." Then
If MsgBox("Vous utiliser le point " & _
"comme symbole de groupement des chiffres. Cela risque de créer un conflit (voir Aide)." _
& vbLf & vbLf & _
"Souhaitez-vous modifier le symbole ?", vbExclamation + vbYesNo _
, "Séparateur") = vbYes Then Call ChangeSepMil("")
End If
End Function
'change le séparateur décimal pour "Nouveau"
Sub ChangeSepMil(Nouveau As String)

'séparateur de millier
SetLocaleInfo 0, &HF, Nouveau
'le séparateur du système a bien été changé mais Excel n´est pas mis à
'jour...
If MsgBox("Le changement de séparateur du système nécessite" & vbLf _
& "qu´Excel soit fermé puis relancé pour être pris en compte." & _
vbLf & vbLf & "Fermer maintenant ?", vbYesNo + vbExclamation) = vbYes Then Application.Quit
End Sub


'Macros crées le 24 juillet 2002 par Michael Desveaux

Sub CleanDate()

Dim NbrNom As Byte
Dim MyName As String
Dim MyDate As Date
Dim Feuille As Worksheet
Dim NewChaine As Double

Set Feuille = ActiveSheet
NbrNom = Feuille.QueryTables.Count
Application.StatusBar = "Nettoyage en cours..."
For i = 1 To NbrNom

MyName = Feuille.QueryTables.Item(i).Name
If InStr(1, MyName, "z", vbTextCompare) <> 0 Then GoTo done
Range(MyName).Select

For Each Cell In Selection
SiBar = InStr(1, Cell.Value, "/", vbTextCompare)
SiPoint = InStr(1, Cell.Value, ".", vbTextCompare)
If SiBar <> 0 Then 'Nettoie la date
MyDate = Cell.Value 'Si un caract "/" est trouvé
Cell.Value = MyDate
End If
If SiPoint <> 0 Then
NewChaine = Replace(Cell.Value, ".", ",", 1, 1, vbTextCompare)
Cell.Clear 'Nettoie les cours
Cell.Value = NewChaine 'Si un "." est trouvé
Cell.NumberFormat = "0.00"
End If
Next Cell
Range(MyName).Columns.BorderAround (xlContinuous)
Feuille.QueryTables.Item(i).Name = MyName & "z"
done: 'Le z indique à Xl que le nettoyage date et décimale
Next i 'a été réalisé
Application.StatusBar = False
End Sub

Sub CleanColonnes()
Dim NbrNom As Byte
Dim MyName As String
Dim Feuille As Worksheet
Application.DisplayAlerts = False
Set Feuille = ActiveSheet
NbrNom = Feuille.QueryTables.Count

For i = 1 To NbrNom

MyName = Feuille.QueryTables.Item(i).Name
If InStr(1, MyName, "y", vbTextCompare) <> 0 Then GoTo doneCol
With Range(MyName)
.Select
.Cells(2, 2).Copy Destination:=Range(MyName).Cells(1, 1)
.Columns(2).EntireColumn.Delete
.Columns(2).EntireColumn.Delete 'Suppression des colonnes
.Columns(3).EntireColumn.Delete 'Et petite presentation
.Columns.HorizontalAlignment = xlHAlignCenter
.Rows(1).Merge
.Columns.EntireColumn.AutoFit
.Columns.BorderAround (xlContinuous)
.Rows(1).BorderAround (xlContinuous)
End With
Feuille.QueryTables.Item(i).Name = MyName & "y"
Next i 'Le y indique à Xl que le nettoyage colonne
doneCol: 'a déjà été réalisé
Application.DisplayAlerts = True
End Sub

Sub FindClasseur(MyType)
Dim NbrClasseur, Requete As Byte
Dim Nom As String

NbrClasseur = Application.Workbooks.Count

For i = 1 To NbrClasseur

Application.Workbooks(i).Activate

'Recherche un classeur avec des QueryTables puis lance le nettoyage choisi
For j = 1 To ActiveWorkbook.Worksheets.Count
Requete = ActiveWorkbook.Worksheets(j).QueryTables.Count
ActiveWorkbook.Worksheets(j).Activate
If Requete <> 0 Then
Select Case MyType
Case Is = "date"
Call CleanDate
Case Is = "Colonnes"
Call CleanColonnes
Case Is = "Nommer"
Call NommerPlage
End Select
End If
Next j

Next i


End Sub

Sub NommerPlage()

Dim NbrNom As Byte
Dim MyName As String
Dim Feuille As Worksheet
Application.DisplayAlerts = False
Set Feuille = ActiveSheet
NbrNom = Feuille.QueryTables.Count


For i = 1 To NbrNom
MyName = Feuille.QueryTables.Item(i).Name
NbrName = Feuille.Names.Count

If InStr(1, MyName, "y", vbTextCompare) <> 0 _
And InStr(1, MyName, "w", vbTextCompare) = 0 Then
NomPlage = Range(MyName).Cells(1, 1).Value
NomPlage = Verification(NomPlage)
Nbrligne = Range(MyName).Rows.Count
Range(Range(MyName).Rows(2), Range(MyName).Rows(Nbrligne - 1)).Select
Selection.Name = NomPlage
End If

Feuille.QueryTables.Item(i).Name = MyName & "w"
'idem y et z, avec w
Next i


End Sub

Function Verification(NameToCheck)

If InStr(1, NameToCheck, " ", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, ".", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, "(", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, ")", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, "+", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, "-", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, ",", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, "'", vbTextCompare) <> 0 Or _
InStr(1, NameToCheck, "@", vbTextCompare) <> 0 Then

Verification = InputBox("Le nom de l'action ne peut être utilisé pour nommer" & _
" la plage car il contient un caractère interdit (type espace ou @)." _
& Chr(10) & Chr(10) & "Veuillez entrer un nom valable pour l'action : " _
& Chr(10) & NameToCheck, "CotationsXl - Erreur")
Else
Verification = NameToCheck
End If

End Function

Sub GetNomAction(NomEnt, Code, Indice, Marché, NbCar)

Dim TabAction(1 To 500) As String

Prepa_bd.Combo_result.Clear 'vide la combo_box résultat

If Indice <> "" Then Call ByIndice(Indice, TabAction)
If Marché <> "" Then Call ByMarché(Marché, Indice, TabAction)
If NomEnt <> "" Then Call ByNomEnt(NomEnt, NbCar, TabAction)
If Code <> "" Then Call ByCode(Code, TabAction)

'affiche les résultats dans Prepa_bd
For i = 1 To 500
If TabAction(i) = "" Then Exit For
Prepa_bd.Combo_result.AddItem TabAction(i)
TabAction(i) = ""
Next i
On Error Resume Next
Prepa_bd.Combo_result.Value = Prepa_bd.Combo_result.List(0)
Prepa_bd.text_trouv.Caption = "Actions trouvées (" & i - 1 & ") :"
End Sub

Sub ByCode(Code, TabAction)

If TabAction(1) <> "" Then
i = 1
For Each Indice In TabAction
TabAction(i) = ""
i = i + 1
Next Indice
End If

Range("CodeSicovam").Select

For Each Cell In Selection
If Cell.Text = Code Then
Cell.Activate
TabAction(1) = ActiveCell.Offset(0, 1).Value
End If
Next Cell

End Sub

Sub ByNomEnt(NomEnt, NbCar, TabAction)

i = 1
If TabAction(1) <> "" Then
'Recherche quand multi-critère
j = 1
For Each Indice In TabAction
NomDsCell = Left(Indice, NbCar)
If NomDsCell = NomEnt Then
TabAction(i) = Indice
If j <> i Then
TabAction(j) = ""
End If
i = i + 1
Else
TabAction(j) = ""
End If
j = j + 1
Next Indice
Else
'Recherche simple
Range("NomAct").Select
For Each Cell In Selection
NomDsCell = Left(Cell.Value, NbCar)
If NomDsCell = NomEnt Then
TabAction(i) = Cell.Value
i = i + 1
End If
Next Cell
End If
End Sub

Sub ByIndice(Indice, TabAction)

i = 1

Select Case Indice
Case Is = "CAC 40"
Range("CAC40").Select
Decalage = -2
Case Is = "IT CAC"
Range("ITCAC").Select
Decalage = -3
Case Is = "IT CAC50"
Range("ITCAC50").Select
Decalage = -4
Case Is = "SBF 120"
Range("SBF120").Select
Decalage = -5
Case Is = "SBF 250"
Range("SBF250").Select
Decalage = -6
Case Is = "Mid CAC"
Range("MidCAC").Select
Decalage = -7
End Select

For Each Cell In Selection
If Cell.Value = "X" Then
TabAction(i) = Cell.Offset(0, Decalage).Value
i = i + 1
End If
Next Cell

End Sub

Sub ByMarché(Marché, Indice, TabAction)
Dim TabTemp(1 To 500)

i = 1

Select Case Marché
Case Is = "Premier marché"
Range("PremierM").Select
Decalage = -8
Case Is = "Second marché"
Range("SecondM").Select
Decalage = -9
Case Is = "Nouveau marché"
Range("NouveauM").Select
Decalage = -10
End Select

If TabAction(1) <> "" Then
'Recherche multi-critère
For Each Cell In Selection
If Cell.Value = "X" Then
Var = Cell.Offset(0, Decalage).Value
For Each Item In TabAction
If Var = Item Then
TabTemp(i) = Item
i = i + 1
End If
Next Item
End If
Next Cell
j = 1
For Each Item In TabAction
TabAction(j) = TabTemp(j)
j = j + 1
Next Item
Else
'Recherche simple
For Each Cell In Selection
If Cell.Value = "X" Then
TabAction(i) = Cell.Offset(0, Decalage).Value
i = i + 1
End If
Next Cell
End If
End Sub


'Macros crées par Michael Desveaux le 23 juillet 2002

Sub InserMenu()

'Déclaration des objets pour la construction des menus
Dim MenuFonction As CommandBarPopup
Dim MenuBourse As Object
Dim MenuClean As Object
Dim SubBourse1 As CommandBarButton
Dim SubClean1 As CommandBarButton
Dim SubClean2 As CommandBarButton
Dim SubClean3 As CommandBarButton
Dim SubClean4 As CommandBarButton
Dim SubBourse2 As CommandBarButton
Dim SubBourse3 As CommandBarButton

Set MenuFonction = Application.CommandBars(1).Controls(7)

'Installe les différents menus
Set MenuBourse = MenuFonction.Controls.Add(msoControlPopup) 'Insére le groupe Bourse
MenuBourse.Caption = "Bourse"
MenuBourse.BeginGroup = True

Set SubBourse1 = MenuBourse.Controls.Add(msoControlButton) '1er sous-menu Bourse
SubBourse1.Caption = "Télécharger historiques"
SubBourse1.FaceId = 956
SubBourse1.OnAction = "DownloadHisto"

Set MenuClean = MenuBourse.Controls.Add(msoControlPopup) 'Insère Sous-groupe Nettoyage
MenuClean.Caption = "Nettoyer les données"

Set SubClean1 = MenuClean.Controls.Add(msoControlButton) '1er Sous-groupe Nettoyage->date
SubClean1.Caption = "Vérifier dates et séparateurs"
SubClean1.FaceId = 2006
SubClean1.OnAction = "NetDate"

Set SubClean2 = MenuClean.Controls.Add(msoControlButton)
SubClean2.Caption = "Supprimer les colonnes NOM et SICOVAM" '2eme Sous-groupe Nettoy->Colonne
SubClean2.FaceId = 214
SubClean2.OnAction = "NetColonne"

Set SubClean3 = MenuClean.Controls.Add(msoControlButton)
SubClean3.Caption = "Nommer les plages avec le nom des actions" '4eme Sous-groupe Nettoy->nommer
SubClean3.FaceId = 1549
SubClean3.Enabled = False
SubClean3.OnAction = "NetNommer"

Set SubBourse2 = MenuBourse.Controls.Add(msoControlButton) '4eme sous-menu Bourse
SubBourse2.Caption = "Aide"
SubBourse2.FaceId = 345
SubBourse2.OnAction = "LanceAide"
SubBourse2.BeginGroup = True

Set SubBourse3 = MenuBourse.Controls.Add(msoControlButton) '5eme sous-menu Bourse
SubBourse3.Caption = "Fermer"
SubBourse3.FaceId = 536
SubBourse3.OnAction = "DesInstall"

End Sub

Sub DelMenu()
Dim MenuDel As CommandBarPopup

On Error Resume Next
Set MenuDel = Application.CommandBars(1).Controls(7)
MenuDel.Controls("Bourse").Delete

End Sub

Sub DownloadHisto()
Call SysSepMil
Prepa_choix.Show
End Sub

Sub NetDate()
Dim MyType As String

MyType = "date"
NomFirst = ActiveWorkbook.Name
NomFirstF = ActiveWorkbook.ActiveSheet.Name
Call FindClasseur(MyType)
Workbooks(NomFirst).Worksheets(NomFirstF).Activate

End Sub

Sub NetColonne()
Dim MyType As String
Dim MenuToEnable

MyType = "Colonnes"
NomFirst = ActiveWorkbook.Name
NomFirstF = ActiveWorkbook.ActiveSheet.Name
Call FindClasseur(MyType)
Workbooks(NomFirst).Worksheets(NomFirstF).Activate

Set MenuToEnable = Application.CommandBars(1).Controls(7).Controls("Bourse").Controls(2).Controls(3)
MenuToEnable.Enabled = True

End Sub

Sub NetNommer()
Dim MyType As String

MyType = "Nommer"
NomFirst = ActiveWorkbook.Name
NomFirstF = ActiveWorkbook.ActiveSheet.Name
Call FindClasseur(MyType)
Workbooks(NomFirst).Worksheets(NomFirstF).Activate

Set MenuToEnable = Application.CommandBars(1).Controls(7).Controls("Bourse").Controls(2).Controls(3)
MenuToEnable.Enabled = False

End Sub

Sub LanceAide()

Aide.Show

End Sub

Sub DesInstall()

AddIns("CotationsXL").Installed = False

End Sub

Renard du Désert

téléchargement de cours (macro de Webmaster)

Message par Renard du Désert » 04/10/2003 21:09

Bonjour,

Merci pour les macros de téléchargement des cours.

Je me permets les commentaires suivants :

Macro de Webmaster :
Elle est parfaite pour télécharger les cours de la journée. L'utilisation type que je lui donne est de tenir à jour votre portefeuille.
NB : Dans ma société, elle ne traverse pas les serveurs "proxy" et Firewalls divers et variés. Probablement, elle utilise un numéro de port non autorisé.

Macro de Cyber Papy :
Elle est parfaite pour télécharger les cours d'un nombre limité de valeurs. Une utilisation type que je lui donne est de calculer le risque d'un portefeuille.
NB : Avec office 97, je n'ai pas réussi à l'installer.

Conclusion :
Les 2 macros ont un usage complémentaire.
NB : une rubrique qui les référencerai sur le site www.bnains.org serai très utile...

Avatar du membre
webmaster
Messages : 775
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 04/10/2003 23:57

Bonsoir,

J'ai effacé les messages multiples. Il y a quelques lenteurs en ce moment sur le forum, je vais en parler à l'hébergeur du site.

Concernant les macros, effectivement la mienne a été écrite à l'origine pour mettre à jour quotidiennement un portefeuille. Bien vu :D. Par contre, elle ne fait que du HTTP et utilise donc à ce titre uniquement le port 80, lequel est sauf cas extraordinaire forcément ouvert sur les firewalls. Peut-être est-ce le site Euronext qui est bloqué ?

La rubrique 'macros' est à l'étude, mais il y a tellement de rubriques en cours de rédaction qu'elle risque de ne pas voir le jour avant quelques temps...

En attendant, si des besoins sont exprimés, on peut les étudier ensemble.

Webmaster

arfima
Messages : 5
Enregistré le : 17/12/2003 13:16

un retour

Message par arfima » 12/06/2004 12:24

bonjour a tout le monde...

je me permet de faire remonter ce topic, car, un, je suis un lecteur assidu de ce forum, et deux, je fus un utlisateur de cette macro...

voilà, sbf-bourse de paris a changé son site, en passant enfin sur euronext, mais les changements font que cela est impossible de l'utiliser de nouveau ces macros...serait-il possible que qq'un mette à jour le fabuleux instrument qu'était cette macro...

en vous remerciant...

Avatar du membre
webmaster
Messages : 775
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 13/06/2004 19:23

Bonjour,

Effectivement, suite au remplacement du site de la SBF par celui d'Euronext, les macros de téléchargement des cours ne fonctionnent plus. Et sur le site d'Euronext, lorsque l'on clique sur le bouton 'Télécharger' d'une liste de valeurs, on obtient un fichier avec les noms et les codes des valeurs, mais sans les cours !?! Sympa non ?

Ce qui oblige à exploiter directement le html renvoyé au navigateur pour affichage, c'est à dire à en extraire les données. Heureusement, ce n'est pas très compliqué. Vous trouverez donc ci-dessous l'ancienne macro de récupération des cours, adaptée au nouveau site Euronext.

Attention : comme on récupère les pages html plutôt que les données brutes, le téléchargement est plus long qu'avant. Donc ne pas s'impatienter, surtout si l'on dispose d'une liaison lente.

Ci-dessous le post du 17/09/2003 repris et adapté.

Il y a une macro et une fonction. La macro permet de récupérer les cours de tous les titres des différents marchés sur le site d'Euronext. Elle crée une feuille 'Valeurs' dans le classeur courant, effectue une vingtaine de GET HTTP sur le site d'Euronext pour récupérer les valeurs des différents marchés (PM, SM, NM, ML et Trackers). Les codes ISIN, intitulés et cours des valeurs sont stockés dans la feuille 'Valeurs'.

Ensuite, la fonction 'getCoursValeur("Code ISIN")' permet de récupérer le cours de cloture d'une valeur depuis une autre feuille en faisant par exemple :

Code : Tout sélectionner

=getCoursValeur&#40;"FR0000120404"&#41;
pour récupérer le cours d'Accor.

ATTENTION : je suis très très loin d'être un expert Excel ou VBA, mon domaine de prédilection étant plutôt le C ou l'assembleur, les exemples de code ci-dessous ne sont sûrement pas les plus beaux ou les mieux intégrés que l'on puisse trouver. M'enfin ils marchent. Et avec quelques échanges, on doit pouvoir les améliorer.

J'ai testé il y a quelques temps les requêtes WEB d'Excel, mais je n'ai jamais réussi à les faire fonctionner correctement. Du moins, leur résultat est souvent pour le moins inatendu ! Donc, je me suis orienté plutôt vers l'utilisation de la librairie Wininet gracieusement fournie par Microsoft. Celle-ci permet de récupérer des pages WEB avec un minimum de code. Les avantages de cette méthode sont multiples : rapidité, simplicité, compatibilité (ça doit marcher avec OpenOffice par exemple), etc.

Par contre, comme je suis un nain d'Excel, le code VBA en question devra être collé manuellement dans un module vba du classeur Excel que vous utilisez, en faisant :
1) ALT + F11
2) Dans la fenêtre "Projet - VBAProject" en haut à gauche, clic droit sur le nom du classeur, puis "Insertion", puis "Module"
3) Ouvrir le module inséré (en général "Module1", sous "Modules")
4) Coller le code suivant dedans :

Code : Tout sélectionner

'******************************************************************************
'*                                 Module Cours                               *
'******************************************************************************
'*                                                                            *
'* DESCRIPTION. &#58; Ensemble de macros et fonctions permettant de recuperer des *
'*               cours de valeurs mobilieres sur Internet.                    *
'*                                                                            *
'* AUTEUR...... &#58; webmaster 'La Bourse pour les nains'                        *
'*                http&#58;//www.bnains.org/                                      *
'*                                                                            *
'* VERSION..... &#58; 0.1                                                         *
'*                                                                            *
'* ENVIRONNEMENT&#58; Win32. Necessite Wininet. Compatible Excel et OpenOffice &#40;a *
'*                verifier&#41;.                                                  *
'*                                                                            *
'* MACROS EXPORTEES &#58;                                                         *
'*   telechargeCours = provoque la creation d'une feuille 'valeurs' a la fin  *
'*                     du classeur courant et y colle les cours des valeurs   *
'*                     de cinq marches, telecharges depuis le site d'Euronext *
'*                                                                            *
'* FONCTIONS EXPORTEES &#58;                                                      *
'*   getCoursValeur &#40; szCodeISIN &#41; = renvoie le cours de cloture de la valeur *
'*                                   dont le code ISIN est passe en parametre.*
'*                                                                            *
'******************************************************************************
'* MODIFIE LE &#58; 13/06/2004 PAR Webmaster http&#58;//www.bnains.org/               *
'* DESCRIPTION DE LA MODIFICATION &#58;                                           *
'* Adaptation des fonctions telechargeCours&#40;&#41; et recupereCours&#40;&#41; suite à      *
'* modification du site Euronext &#40;fermeture site SBF remplacé par site        *
'* Euronext&#41;.                                                                 *
'*                                                                            *
'* MODIFIE LE &#58; ../../.... PAR ...............                                *
'* DESCRIPTION DE LA MODIFICATION &#58;                                           *
'*                                                                            *
'******************************************************************************

Option Explicit
'==============================================================================
' Import
'==============================================================================
Public Declare Function InternetOpenA Lib "wininet" _
    &#40;ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long&#41; As Long
    
Public Declare Function InternetCloseHandle Lib "wininet" _
    &#40;ByVal hInet As Long&#41; As Integer
    
Public Declare Function InternetOpenUrlA Lib "wininet" _
    &#40;ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long&#41; As Long
    
Public Declare Function CloseHandle Lib "kernel32" &#40;ByVal hObject As Long&#41; As Long

Public Declare Function InternetReadFile Lib "wininet" _
    &#40;ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long&#41; As Integer

'==============================================================================
' Déclarations de constantes
'==============================================================================
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_FLAG_RELOAD = &H80000000

Public Const COLONNE_COURS_CLOTURE = 3
Public Const COLONNE_CODE_ISIN = 1


'******************************************************************************
'*                         Macro telechargerCours                             *
'******************************************************************************
'*                                                                            *
'* Description &#58; cette macro cree une feuille 'Valeurs' a la fin du classeur  *
'*               courant, puis recupere les cours de differents marches.      *
'*                                                                            *
'******************************************************************************
Sub telechargeCours&#40;&#41;
' ----- On efface le contenu de la feuille des valeurs -----
Dim bValeurs As Boolean
Dim i As Integer
Dim s As Worksheet

bValeurs = False
For i = 1 To Sheets.Count
  If &#40;Sheets&#40;i&#41;.Name = "Valeurs"&#41; Then
    bValeurs = True
  End If
Next i

Application.DisplayAlerts = False
If &#40;bValeurs = True&#41; Then
  Worksheets&#40;"Valeurs"&#41;.Delete
End If
Set s = Sheets.Add&#40;After&#58;=Worksheets&#40;Worksheets.Count&#41;&#41;
s.Name = "Valeurs"
Application.DisplayAlerts = True

Dim iPage As Integer
' Premier marché
iPage = 1
While &#40;iPage <> -1&#41;
  iPage = recupereCours&#40;"http&#58;//www.euronext.com/trader/priceslists/1/wide/0,4614,1679_338638,00.html?mep=89291&searchList=market_7&economicGroupList=&eligibilityList=&pageIndex=" + Format&#40;iPage&#41;, iPage&#41;
Wend
' Second marché
iPage = 1
While &#40;iPage <> -1&#41;
  iPage = recupereCours&#40;"http&#58;//www.euronext.com/trader/priceslists/1/wide/0,4614,1679_338638,00.html?mep=89291&searchList=market_8&economicGroupList=&eligibilityList=&pageIndex=" + Format&#40;iPage&#41;, iPage&#41;
Wend
' Nouveau marché
iPage = 1
While &#40;iPage <> -1&#41;
  iPage = recupereCours&#40;"http&#58;//www.euronext.com/trader/priceslists/1/wide/0,4614,1679_338638,00.html?mep=89291&searchList=market_9&economicGroupList=&eligibilityList=&pageIndex=" + Format&#40;iPage&#41;, iPage&#41;
Wend
' Marché libre
iPage = 1
While &#40;iPage <> -1&#41;
  iPage = recupereCours&#40;"http&#58;//www.euronext.com/trader/priceslists/1/wide/0,4614,1679_338638,00.html?mep=89291&searchList=market_10&economicGroupList=&eligibilityList=&pageIndex=" + Format&#40;iPage&#41;, iPage&#41;
Wend
' Trackers
iPage = recupereCours&#40;"http&#58;//www.euronext.com/pricesearch/0,4771,1679_3232895,00.html?requestComesFromSearchBoxParameter=true&instrumentType=4&securityType=401&matchpattern=&exposure=&underlyingType=&productFamily=&indexFamily=&sector=", 1&#41;
End Sub


'******************************************************************************
'*                         Fonction recupereCours                             *
'******************************************************************************
'*                                                                            *
'* Description &#58; cette fonction recupere une page sur le site Euronext, en    *
'*               extrait les intitulés, codes et cours des valeurs et renvoie *
'*               eventuellement la page suivante si il y en a une.            *
'*               Les intitulés, codes et cours des valeurs sont ajoutées dans *
'*               la feuille 'valeurs' du classeur courant.                    *
'*                                                                            *
'* Entree &#58; URL des donnees a recuperer.                                      *
'*                                                                            *
'* Sortie &#58; ajout de lignes dans la feuille 'Valeurs' du classeur.            *
'*                                                                            *
'* Retour &#58; numero de la page suivante &#40;parametre 'pageIndex' Euronext&#41;.      *
'*                                                                            *
'******************************************************************************
Function recupereCours&#40;szUrl As String, iPage As Integer&#41; As Integer
  Dim hInternetSession As Long     ' handle de la session internet
  Dim hPage As Long                ' handle de la page
  Dim iPageSuivante As Integer

  '------ On ouvre une connexion -----
  hInternetSession = InternetOpenA&#40;"Wininet", 1, vbNullString, vbNullString, 0&#41;
  If &#40;hInternetSession <> 0&#41; Then
    ' ----- On ouvre la page demandee -----
    hPage = InternetOpenUrlA&#40;hInternetSession, szUrl, vbNullString, 0, _
                             INTERNET_FLAG_RELOAD, 0&#41;
    If &#40;hPage <> 0&#41; Then
      Dim szBuffer As String * 32000   ' Buffer pour lecture de la page
      Dim lNbOctLus As Long            ' Pour recevoir le nombre d'octets lus
      Dim bRet As Boolean              ' Pour le code de retour de la lecture
      Dim iLigne As Integer
      Dim iColonne As Integer
      Dim szPage As String
      
      ' ----- On cherche la premiere ligne vide -----
      iLigne = 1
      iColonne = 1
      While &#40;Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, iColonne&#41;.Value <> ""&#41;
        iLigne = iLigne + 1
      Wend
      
      ' ----- On lit le contenu de la page -----
      szPage = vbNullString
      Do
        szBuffer = vbNullString
        bRet = InternetReadFile&#40;hPage, szBuffer, Len&#40;szBuffer&#41;, lNbOctLus&#41;
        If &#40;bRet = True&#41; Then
          szPage = szPage & Mid$&#40;szBuffer, 1, lNbOctLus&#41;
        End If
      Loop While &#40;bRet = True And lNbOctLus <> 0&#41;
          
      ' ----- On ferme le handle de la page -----
      CloseHandle &#40;hPage&#41;
    
      Dim iDeb As Long    ' pointeur dans la page
      iDeb = 1
            
      ' ----- On cherche le debut des donnees qui nous interessent -----
      While &#40;InStr&#40;iDeb, szPage, "<td class=" + Chr&#40;34&#41; + "tableBgColor2" + Chr&#40;34&#41; + "><span class=" + _
                                 Chr&#40;34&#41; + "tableValueName" + Chr&#40;34&#41; + ">"&#41; _
             And _
             InStr&#40;iDeb, szPage, "?isinCode="&#41;&#41;
        Dim deb As Long
        Dim fin As Long
        Dim szCodeISIN As String
        Dim szNom As String
        Dim szCours As String
              
        deb = InStr&#40;iDeb, szPage, "?isinCode="&#41;
        If &#40;deb <> 0&#41; Then
          ' Code ISIN
          deb = deb + Len&#40;"?isinCode="&#41;
          fin = InStr&#40;deb, szPage, "&"&#41;
          szCodeISIN = Mid$&#40;szPage, deb, fin - deb&#41;
          Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, iColonne&#41;.Value = szCodeISIN
          iColonne = iColonne + 1
          iDeb = fin
          ' Nom
          deb = InStr&#40;iDeb, szPage, ">"&#41;
          deb = deb + 1
          fin = InStr&#40;deb, szPage, "</a>"&#41;
          szNom = Mid$&#40;szPage, deb, fin - deb&#41;
          Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, iColonne&#41;.Value = szNom
          iColonne = iColonne + 1
          iDeb = fin
          ' Cours
          deb = InStr&#40;iDeb, szPage, "tableValueNumCentered" + Chr&#40;34&#41; + ">"&#41;
          deb = deb + Len&#40;"tableValueNumCentered" + Chr&#40;34&#41; + ">"&#41;
          szCours = vbNullString
          While &#40;&#40;Mid$&#40;szPage, deb, 1&#41; >= "0" And Mid$&#40;szPage, deb, 1&#41; <= "9"&#41; Or Mid$&#40;szPage, deb, 1&#41; = "."&#41;
            szCours = szCours & Mid$&#40;szPage, deb, 1&#41;
            deb = deb + 1
          Wend
          Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, iColonne&#41;.Value = szCours
          iDeb = fin
          ' Ligne suivante
          iColonne = 1
          iLigne = iLigne + 1
        End If
      Wend
            
    End If
      
    ' ----- Et on regarde si il y a une page suivante -----
    Dim SZ_PAGE_INDEX As String
    SZ_PAGE_INDEX = "?pageIndex="

    iPageSuivante = -1
    If &#40;InStr&#40;iDeb, szPage, SZ_PAGE_INDEX&#41;&#41; Then
      While &#40;InStr&#40;iDeb, szPage, SZ_PAGE_INDEX&#41; And iPageSuivante <= iPage&#41;
        iPageSuivante = Mid$&#40;szPage, InStr&#40;iDeb, szPage, SZ_PAGE_INDEX&#41; + Len&#40;SZ_PAGE_INDEX&#41;, InStr&#40;InStr&#40;iDeb, szPage, SZ_PAGE_INDEX&#41;, szPage, "&"&#41; - &#40;InStr&#40;iDeb, szPage, SZ_PAGE_INDEX&#41; + Len&#40;SZ_PAGE_INDEX&#41;&#41;&#41;
        iDeb = InStr&#40;InStr&#40;iDeb, szPage, SZ_PAGE_INDEX&#41;, szPage, "&"&#41; + 1
      Wend
      If iPageSuivante <= iPage Then iPageSuivante = -1          ' Au cas où...
    End If
      
      
    ' ----- On ferme la connexion -----
    InternetCloseHandle &#40;hInternetSession&#41;
  End If
  
  ' On fixe le code retour
  recupereCours = iPageSuivante

End Function


'******************************************************************************
'*                         Fonction getCoursValeur                            *
'******************************************************************************
'*                                                                            *
'* Description &#58; cette fonction renvoie le cours de cloture d'une valeur en   *
'*               fonction de son code ISIN. Pour ce faire, elle cherche la    *
'*               valeur dans la feuille 'Valeurs' du classeur courant.        *
'*                                                                            *
'* Entree &#58; szCodeISIN = code ISIN de la valeur dont on souhaite connaitre le *
'*                       cours de cloture.                                    *
'*                                                                            *
'* Sortie &#58; Neant.                                                            *
'*                                                                            *
'* Retour &#58; cours de cloture ou '?' si valeur non trouvee.                    *
'*                                                                            *
'******************************************************************************
Function getCoursValeur&#40;szCodeISIN As String&#41; As Double
' On cherche le code dans la feuille 'Valeurs'
Dim iLigne As Integer

iLigne = 1
While &#40;Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_CODE_ISIN&#41;.Value <> "" And _
        Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_CODE_ISIN&#41;.Value <> szCodeISIN&#41;
  iLigne = iLigne + 1
Wend

If Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_CODE_ISIN&#41;.Value = "" Then
  getCoursValeur = "?"
  Exit Function
End If

getCoursValeur = Worksheets&#40;"Valeurs"&#41;.Cells&#40;iLigne, COLONNE_COURS_CLOTURE&#41;.Value

End Function
Voilà, il suffit maintenant d'enregistrer le tout et vous pouvez fermer l'éditeur VBA.

Dans votre classeur Excel, faites "Outils/Macro/Macros...", sélectionnez "telechargeCours" et cliquez sur le bouton "Exécuter". Selon votre connexion internet et l'état du serveur Euronext, cela peut durer une ou deux minutes, voire davantage. Ne vous inquiétez pas, il suffit d'attendre...

A la fin, une feuille nommée 'Valeurs' est ajoutée (ou remplacée) à la fin de votre classeur. Elle contient environ 1200 valeurs avec leurs code ISIN, libellé et cours de cloture.

Dans n'importe quelle autre feuille du classeur, il suffit pour obtenir un cours de cloture d'appeler la fonction getCoursValeur () en lui passant le code ISIN de la valeur recherchée en paramètre. Il est inutile d'être connecté pour cette phase là car la fonction getCoursValeur va chercher dans la feuille 'Valeurs' créée lors du téléchargement.

Il ne reste plus qu'à mettre le code dans un classeur .xla pour pouvoir l'exploiter sans avoir à dupliquer le code dans chaque classeur et à enrichir la chose d'autres fonctions.

J'allais oublier : comme Excel ne recalcule les formules par défaut que lors de l'ouverture du classeur ou de la modification d'une référence, il ne le fait pas lorsque l'on relance la macro telechargeCours. Donc, pour que toutes les cellules contenant des "=getCoursValeur("Code_ISIN")" soient remises à jour, il suffit de forcer un recalcul général de la feuille via CTRL-ALT-F9.

Dès que j'en trouverais le temps, j'ajouterai une rubrique 'Excel' dans le site.

Webmaster

Invité

merci

Message par Invité » 13/06/2004 19:47

hé bien, merci bcp...

il est juste dommage que les cours d'ouverture, max min ne soient pas présents...je vais essayer de l'adapter...

merci encore...et l'idée de la rubrique excel ou macro est trés bonne...

à quoi me servent ces données...j'essaye d'avoir le meilleur modèle de prévision possible...neural network...

Dep57

Cours Intraday

Message par Dep57 » 23/06/2004 00:29

Bonjour,

bravo pour vos macros :P

Quand à moi, je cherche les cours INTRADAY (Historique) des valeurs du CAC40.

On peut récupérer l'intraday d'une valeur sur Euronext mais celle de la veille (ou de la cotation en cours, décalé de 15 minutes).

Existe-t-il un site ou on peut télécharger ces données ?

Bonne continuation à tous :lol:

Répondre

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité