Valeurs multiples dans code HTML dont les balises sont identiques

bonjour,

j'ai modifié le nom de la feuille et du tableau en utilisant directement le nom du tableau structuré.

Puis je mémorise les résultats dan une matrice aOut et comme-ça je n'écrase qu'une partie du tableau, donc les formules éventuelles ne seront pas supprimées.

Merci

quand je lance la macro ca me génère une erreur ici :

re,

j'ai ajouté un lien erronné (cet action n'existe pas je suppose) comme 3eme ligne

Puis j'ai ajouté ceci avant ce FOR...NEXT & une gestion des erreurs pour traiter cette erreur

 Set TableHtmL = Nothing       'RAZ cet object

Donc je suppose que vous aurez un Msgbox pour un de vos actions, mais la macro n'arrêtera plus en erreur.

J'ai pas mal d'erreurs

Je viens de repartir du V3 , ce que je ne comprends pas c'est que je prends votre fichier V3 , je colle dedans le script proposé par Patrick et cela ne fonctionne pas

Je suis remonté sur cet échange , celui la fonctionne bien

Ensuite ceux que tu repropose ils ne fonctionnent pas pour moi

Ils bloquent ici :

je ne comprend pas comment le fichier fonctione chez vous sur la trame que je vous ai envoyé

Vous nommez mon tableau ( "tableau_cotations" )

Mais pas la feuille ( qui se nomme "cotations" )

pouvez-vous m"envoyer votre fichier ?

blad1!range("tableau1")

"blad1" indique le "codename" de votre feuille, son vrai nom est "cotations". Donc dans l'editeur VBA vou voyez en premiere position le codename et entre les parenthèses le vrai nom. Si vous ne savez pas le codename, vous modifiez blad1!range("tableau1") en sheets("cotations").range("tableau1")

Concernant le nom d'un tableau, je suppose que vous connaissez cela, non ?

Merci Bart,

alors oui j'étais bien à coté de la plaque ... :-)

donc le VBA : Feuil1(COTATIONS)

le tableau : tableau_cotations

le code utilisé :

Function GetHtmlcode(UrL As String)
     On Error Resume Next
     With CreateObject("MSXML2.XMLHTTP")
          .Open "GET", UrL, False
          .Send
          If .Status = 200 Then
               GetHtmlcode = .responsetext
          End If
     End With
End Function

Sub m_GO()
     Dim tbl, UrL$, Codehtml, oTable, TableHtmL, TRS, LiG&, C&, E, A&, b, sCurr, sp
     tbl = Feuil1.Range("tableau_cotations")
     For LiG = 1 To UBound(tbl)
          UrL = tbl(LiG, 1)
          Application.StatusBar = "Téléchargement des données de :    " & tbl(LiG, 1)
          Codehtml = GetHtmlcode(UrL)
          With CreateObject("htmlfile")
               .body.innerhtml = Codehtml

               For Each oTable In .getelementsbytagname("TABLE")     'boucler chaque tableau
                    If InStr(1, oTable.innertext, "Bénéfice net par action") > 0 Then Set TableHtmL = oTable     'tableau contient ce texte
               Next oTable

               If Not TableHtmL Is Nothing Then
                    Set TRS = TableHtmL.getelementsbytagname("TR")
                    E = 0
                    sCurr = ""
                    For trl = 1 To TRS.Length - 1
                         A = 3
                         For C = 1 To 3
                              E = E + 1
                              sp = Split(Trim(TRS(trl).Cells(C).innertext)) 'séparer avec l'espace
                              b = (Right(sp(0), 1) = "%") 'drapeau dernier charactère est %
                              tbl(LiG, A + (E - 1)) = CDbl(Replace(Left(sp(0), Len(sp(0)) + b), ",", ",")) * IIf(b, 0.01, 1) 'valeur éventuellement divisé par 100 pour les pourcentages
                              If UBound(sp) >= 1 Then sCurr = sp(1) 'si le currency est connu, mémorisez-le
                         Next
                    Next
                    tbl(LiG, UBound(tbl, 2)) = sCurr 'currency
               End If
          End With
     Next
     With Feuil1.Range("tableau_cotations")
          .ClearContents
          .Value = tbl
     End With
     Application.StatusBar = False

End Sub

quand je lance j'ai un message d'erreur ici :

re

Bonjour

moi je comprends pas on avait un cahier des charges et maintenant tout est différent

le tableau ,les colonnes ,le nombre de colonne , les index ,le nom du tableau

bref si a chaque fois que l'on avance tu change tout , fait le à la main ça ira plus vite

je t'ai donné un exemple tu a copié le code comme tel tu m’étonne que ça match pas

déjà l'url n'est plus dans la colonne 1 mais 3

la variable A commence plus a 3 elle devrait commencer à range("AF").column

et j'en passe et des meilleures

bref bon courage

si tu fait ce que je dis

Sub m_GO()
     Dim tbl, UrL$, Codehtml, oTable, TableHtmL As Object, TRS, LiG&, C&, E, A&, b, sCurr, sp
     tbl = Feuil1.Range("tableau_cotations")
     For LiG = 1 To UBound(tbl)
          UrL = tbl(LiG, 3)
          Application.StatusBar = "Téléchargement des données de :    " & tbl(LiG, 1)
          Codehtml = GetHtmlcode(UrL)
          With CreateObject("htmlfile")
               .body.innerhtml = Codehtml

               For Each oTable In .getelementsbytagname("TABLE")     'boucler chaque tableau
                    If InStr(1, oTable.innertext, "Bénéfice net par action") > 0 Then Set TableHtmL = oTable     'tableau contient ce texte
               Next oTable

               If Not TableHtmL Is Nothing Then
                   On Error Resume Next
                   Set TRS = TableHtmL.getelementsbytagname("TR")
                    E = 0
                    sCurr = ""
                    For trl = 1 To TRS.Length - 1
                         A = Feuil1.Range("AF1").Column
                         For C = 1 To 3
                              E = E + 1
                              sp = Split(Trim(TRS(trl).Cells(C).innertext)) 'séparer avec l'espace
                              b = (Right(sp(0), 1) = "%") 'drapeau dernier charactère est %
                              tbl(LiG, A + (E - 1)) = CDbl(Replace(Left(sp(0), Len(sp(0)) + b), ",", ",")) * IIf(b, 0.01, 1) 'valeur éventuellement divisé par 100 pour les pourcentages
                              If UBound(sp) >= 1 Then sCurr = sp(1) 'si le currency est connu, mémorisez-le
                         Next
                    Next
                    tbl(LiG, UBound(tbl, 2)) = sCurr 'currency
               End If
          End With
     Err.Clear
     Next
     With Feuil1.Range("tableau_cotations")
          .ClearContents
          .Value = tbl
     End With
     Application.StatusBar = False

End Sub

Bonjour Patrick ,

désolé si je n'ai pas été clair :-(

cependant je viens de relire nos échange et les captures d'écrans que j'ai déposé depuis le début et je vous confirme que rien n'a jamais été modifié de mon coté . ( par exemple la colonne C des valeurs que j'ai mis dans mon imprime écran du 18/09 )

Quand vous m'avez proposé vos fichiers Excel et vue toute l'aide que vous m'avez apporté j'ai tenté de les adapter au miens pour justement ne pas ajouter de complications supplémentaires. Je n'ai rien changé à mes noms de tableau, colonnes ou autre depuis le départ , c'est déjà bien assez compliqué pour moi

du coup je vais préciser avant de modifier le code que vous venez d'envoyer

je vois le code fonctionner mais il interroge la colonne A ( le nom des entreprise ) je vais modifier pour qu'il prenne la colonne C ( le lien Bourso )

et qui je précise n'a jamais changé depuis le départ :-)

Merci Bart ,

y a quand même un truc étrange .... je télécharge ton fichier , je l'ouvre , je clique sur le bouton MARCO et j'ai une erreur ( alors que je n'ai rien touché je précise :-)

Toi quand tu ouvre le fichier et que tu clique sur la macro tu n'a pas d'erreur ?

puis je clique sur débogage

re,

dans le statusbar en bas à gauche, il indique quel action, le premier ou un autre ?

Chez moi, cela passe sans problèmes. C'st avec Excel365, mais, il n'y a pas des choses qui ne fonctionnent pas pour un Excel2016.

une nouvelle version, quand la macro s'arrête, vous voyez quoi dans le statusbar ?

je vais tester la nouvelle version .... je vous dit