Cours de bourse sur boursorama

Bonjour ,

J'ai trouvé dans le forum, ce code

https://forum.excel-pratique.com/recherche/boursorama?d=eyJtYyI6ImJvdXJzb3JhbWEiLCJhIjoiIiwiZiI6IjAi...

qui me pose quelques soucis ! j'utilise excel 2007.

les valeurs transmises dans les cellules ne représentent que la valeur entière et oubli la parti décimale

en faisant du pas a pas dans la macro je vois bien qu'il n'y a que la partie entière sans la virgule

j'ai bien trouvé une solution pour MajCotations() et Haut()

Sub MajCotations()
Dim i%, k%, URL$, COT
k = Range("B" & Rows.Count).End(xlUp).Row
    Range(Cells(k, 1), Cells(k, 1)).Clear
avant = """price"":"
apres = ",""priceCurrency"

On Error Resume Next
For i = 4 To k
    DoEvents
        ReDim COT(1 To k, 1 To 1)
        COT(1, 1) = Cells(i, [Cotation].Column).Value
        Test = COT(1, 1)
        URL = Cells(i, [WWW].Column).Value
    Application.StatusBar = "Mise à jour des cotations en cours …"
    On Error Resume Next
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        If .Status = 200 Then COT(i, 1) = Split(Split(.responseText, avant)(1), apres)(0)
    End With
    Application.StatusBar = False
    Test = COT(i, 1)
        Cells(i, [Cotation].Column).Value = COT(i, 1)
Next
End Sub

Sub Haut()
Dim i%, k%, URL$, Haut_Max
Dim avant As String
Dim apres As String
    k = Range("B" & Rows.Count).End(xlUp).Row
    Range(Cells(k, 1), Cells(k, 1)).Clear
    avant = "","high":"   '"quot;high":"
    apres = ","

        On Error Resume Next
    For i = 4 To k
        DoEvents
            ReDim Haut_Max(1 To k, 1 To 1)
            Haut_Max(1, 1) = Cells(i, [Plus_haut].Column).Value
            URL = Cells(i, [WWW].Column).Value
        Application.StatusBar = "Mise à jour des cotations en cours …"
        On Error Resume Next
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, False
            .send
           Test = Val(Split(Split(.responseText, avant)(1), apres)(0))
           Test = Replace(Test, ",", ".")
            If .Status = 200 Then Haut_Max(i, 1) = Test 'Val(Split(Split(.responseText, avant)(1), apres)(0))
        End With
        Application.StatusBar = False
        Test = Haut_Max(i, 1)
        Cells(i, [Plus_haut].Column).Value = Haut_Max(i, 1)
    Next
End Sub

mais je ne trouve aucune solution pour le reste, peut-être quelqu'un sur le forum aura une solution

Bonjour papyvore,

1) Quel fichier avez-vous utilisé ?

2) Je pense que le souci ce situe au moment de transformer le texte nombre en valeur et ce n'est pas que dans 2007

Test = Val(Split(Split(.responseText, avant)(1), apres)(0))

Il faut remplacer ça par

Test = Split(Split(.responseText, avant)(1), apres)(0)

Et travailler sur la valeur retourner en supprimant l'espace par exemple

A+

Bonjour JExcel2fr

merci de cette réponse. mais j'ai du mal m'expliquer le problème n'est pas dans les 2 macros que j'ai édité, celles-ci marchent c'est celles dans ce programme https://forum.excel-pratique.com/recherche/boursorama?d=eyJtYyI6ImJvdXJzb3JhbWEiLCJhIjoiIiwiZiI6IjAi...qui ne marchent pas .

Re,

Arf d'accord, mais le fichier de quelle page, il y en a 9 des pages

De plus le bon code est dans l'une d'elle

Oups c'est plutôt ici https://forum.excel-pratique.com/excel/extraction-de-donnee-bourse-sur-le-site-de-boursorama-186210

le dernier en bas de la page de Artutro83. désolé pour cette erreur

Re,

Et bien voilà quand on a les bonne informations

Il y a effectivement un peu de retraitement à faire, voici le fichier modifié avec une petite fonction de traitement

A+

merci beaucoup ça marche super

Re,

Bonne journée

je rouvre le sujet , en rajoutant des lignes tout n'était pas lu ,je pense qu'il faut remplacer

k = 'Cells(Rows.Count, [REF].Column).End(xlUp).Row

par

k = DerLig 

ça fonctionne pour MajCotations() maispas pour les autres ???

voici ce que j'obtient

pour info les cases vides sont"normales" car ce sont des OPCVM ces valeurs ne sont pas suivit.

C'est seulement le montant 1 123.44€ qui me pose problème

Re,

Il faut modifier la fonction, pour supprimer l'espace des milliers

' Fonction de nettoyage des réponses récupérées
Function ValCot(sRep As Variant, Avt As String, Apr As String)
  ' Récupérer la valeur
  sTmp = Split(Split(sRep, Avt)(1), Apr)(0)
  ' Supprimer les retours à la ligne et les espaces
  sTmp = Trim(Replace(sTmp, Chr(10), ""))
  ' Supprimer l'espace des millier - New 10/10/2024
  sTmp = Replace(sTmp, " ", "")
  ' Remplacer la virgule de la décimale par un point
  sTmp = Replace(sTmp, ",", ".")
  ' Retourner la valeur nettoyée
  ValCot = sTmp
End Function

A+

merci pourquoi j'y pas pensé, l'age sans doute