Traduction de script VBA
Bonjour,
quelqu'un pourrai m'aider à commenter les lignes manquantes dans le script suivant ? je bloque sur la compréhension
Merci pour votre aide
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, LO, aOut, s 'variables utilisées dans la macro
Set LO = Range("tableau_cotations").ListObject 'avec un tableau structuré excel, il ne faut plus spécifier la feuille
tbl = Range("tableau_cotations").Resize(, 3).Value 'selection des 3 premières colonnes du tableau excel
ReDim aOut(1 To UBound(tbl), 1 To 13) 'on écrit vers cette matrice temporaire (qui est vide pour commencer), un tableau à 12 colonnes
For LiG = 1 To UBound(tbl) '<<<<<<<<<<<<<<<<<<< ?????
UrL = tbl(LiG, 3) 'On indique que la variable URL est la 3eme colonne du tableau !!!!
Application.StatusBar = LiG & " des " & UBound(tbl) & ", Téléchargement des données de : " & tbl(LiG, 1) ' voir l'avencement , indique le nom de l'action de la cellule 1
Codehtml = GetHtmlcode(UrL) '<<<<<<<<<<<<<<<< ????
With CreateObject("htmlfile") ' creer un objet HTML qui contient toute la page de l'url
.body.innerhtml = Codehtml
Set TableHtmL = Nothing '<<<<<<<<<<<<< ???
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 ' on selectione le tableau qui contient ce texte parmis tous les tableaux de la page
Next oTable ' on passe la prochaine URL et on recommence à chercher le tableau qui contient ..
If Not TableHtmL Is Nothing Then
s = Application.StatusBar ' <<<<<<< ????
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)) 'on sépare avec l'espace les valeurs trouvées
Application.StatusBar = s & " " & E & " " & sp(0) ' on affiche la progression avec les split pour une meilleurs lisibilitée
attendre
b = (Right(sp(0), 1) = "%") ' <<<<<<<< ?????
aOut(LiG, E) = CDbl(Replace(Left(sp(0), Len(sp(0)) + b), ",", ".")) * IIf(b, 0.01, 1) '<<<<< ??????
If UBound(sp) >= 1 Then sCurr = sp(1) 'si le currency est connu, mémorisez-le ( c'est quoi le curency ? ) ( Ubound est bien la derniere ligne trouvé dans le tableau ? )
Next
Next
aOut(LiG, UBound(aOut, 2)) = sCurr '<<<< ????
End If
End With
Next
LO.ListColumns("div2k23").DataBodyRange.Resize(, 13).Value = aOut ' <<<< ?????
Application.StatusBar = False
End Sub
Sub attendre()
Dim t0, t1
t0 = Timer
t1 = Timer + 0.3
Do
DoEvents
Loop While t0 <= Timer And Timer < t1
End SubBonjour,
Si vous souhaitez vraiment "comprendre" ce code VBA je vous conseille vivement de suivre une formation VBA, par exemple celle du site sur lequel nous nous trouvons. En effet vous avez des interrogations qui dénotent d'un niveau très novice sur le sujet, et afin d'aborder un sujet aussi complexe que celui de votre question il est bon de commencer par les bases.
Voici ci-après votre code commenté et quelques explications sur son fonctionnement.
Function GetHtmlcode(UrL As String)
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", UrL, False
.Send
If .Status = 200 Then
GetHtmlcode = .responsetext '???? → récupère le code HTML de la page si la requête est réussie (code 200)
End If
End With
End Function
Sub m_GO()
Dim tbl, UrL$, Codehtml, oTable, TableHtmL, TRS, LiG&, C&, E, A&, b, sCurr, sp, LO, aOut, s
Set LO = Range("tableau_cotations").ListObject
tbl = Range("tableau_cotations").Resize(, 3).Value
ReDim aOut(1 To UBound(tbl), 1 To 13)
For LiG = 1 To UBound(tbl) '???? → boucle sur chaque ligne du tableau Excel
UrL = tbl(LiG, 3)
Application.StatusBar = LiG & " des " & UBound(tbl) & ", Téléchargement des données de : " & tbl(LiG, 1)
Codehtml = GetHtmlcode(UrL) '???? → télécharge le code HTML de la page web correspondant à l’URL
With CreateObject("htmlfile")
.body.innerhtml = Codehtml
Set TableHtmL = Nothing '???? → initialisation : aucun tableau HTML sélectionné pour l’instant
For Each oTable In .getelementsbytagname("TABLE")
If InStr(1, oTable.innertext, "Bénéfice net par action") > 0 Then Set TableHtmL = oTable
Next oTable
If Not TableHtmL Is Nothing Then
s = Application.StatusBar '???? → sauvegarde du texte affiché dans la barre de statut
Set TRS = TableHtmL.getelementsbytagname("TR") '???? → récupère toutes les lignes du tableau HTML
E = 0 '???? → compteur de colonnes dans la matrice de sortie
sCurr = "" '???? → variable pour stocker la devise (currency)
For trl = 1 To TRS.Length - 1 '???? → boucle sur les lignes du tableau HTML (sauf la première, souvent l’en-tête)
A = 3 '???? → nombre de colonnes à lire dans chaque ligne HTML
For C = 1 To 3 '???? → boucle sur les 3 premières cellules de chaque ligne
E = E + 1 '???? → incrémente le compteur de colonne
sp = Split(Trim(TRS(trl).Cells(C).innertext)) 'sépare le texte de la cellule en mots
Application.StatusBar = s & " " & E & " " & sp(0)
attendre
b = (Right(sp(0), 1) = "%") '???? → vérifie si la valeur se termine par "%" (pourcentage)
aOut(LiG, E) = CDbl(Replace(Left(sp(0), Len(sp(0)) + b), ",", ".")) * IIf(b, 0.01, 1)
'???? → convertit la valeur en nombre (remplace la virgule par un point), divise par 100 si c’est un pourcentage
If UBound(sp) >= 1 Then sCurr = sp(1) '???? → si une deuxième valeur existe (ex: devise), on la stocke
Next
Next
aOut(LiG, UBound(aOut, 2)) = sCurr '???? → stocke la devise dans la dernière colonne de la ligne
End If
End With
Next
LO.ListColumns("div2k23").DataBodyRange.Resize(, 13).Value = aOut '???? → écrit les données extraites dans le tableau Excel
Application.StatusBar = False
End Sub
Sub attendre()
Dim t0, t1
t0 = Timer
t1 = Timer + 0.3
Do
DoEvents
Loop While t0 <= Timer And Timer < t1
End SubCe programme VBA sert à extraire des données financières depuis des pages web, en particulier des tableaux contenant le texte "Bénéfice net par action". Voici les étapes principales :
- Lecture du tableau Excel : Il lit un tableau nommé
tableau_cotationsqui contient des noms d’actions et des URLs vers des pages web financières. - Téléchargement du HTML : Pour chaque URL, il télécharge le code HTML de la page.
- Recherche du bon tableau HTML : Il cherche dans la page un tableau contenant le texte "Bénéfice net par action".
- Extraction des données : Il lit les 3 premières colonnes de chaque ligne du tableau HTML (sauf l’en-tête), extrait les valeurs (en pourcentage ou non), les convertit en nombre, et les stocke dans une matrice temporaire.
- Détection de la devise : Si une devise (comme "EUR", "USD") est présente, elle est mémorisée.
- Écriture dans Excel : À la fin, toutes les données extraites sont écrites dans une colonne nommée
"div2k23"du tableau Excel.
Un grand merci pour votre réponse très détaillée .
Je vais analyser ligne par ligne vos commentaires pour essayer de mieux comprendre ou je bloque
Très bonne journée à vous et merci encore :-)
Re-Bonjour,
Encore merci pour vos éclaircissements sur le fonctionement du code , je pense avoir identifier mon problème .
Pour cela j'ai ajouter un méssage box:
MsgBox TRS(trl).innertextle vba que je vous ai transmis ressort ce formatage :
on y retrouve bien un TITRE , un chiffre avec un % collé à l'arrière , des chiffres suivent d'un espace et du mot EUR ou USD et de chiffres séparés par des points .
On y retrouve et comprends donc bien votre description précédente :
aOut(LiG, E) = CDbl(Replace(Left(sp(0), Len(sp(0)) + b), ",", ".")) * IIf(b, 0.01, 1) ' converti la valeur en nombre , remplace la virgule par un point , divise par 100 si c'est un pourcentageDans un nouveau Vba ( ou du moins une copie du précédent ) je change uniquement le mot de recherche pour tapper dans un autre tableau :
If InStr(1, oTable.innertext, "Janvier ") > 0 Then Set TableHtmL = oTable ' on selectione le tableau qui contient ce texte parmis tous les tableaux de la pageJe supprime également ces lignes de stockage des EUR ou USD qui ne me seront plus utiles dans le nouveau :
sCurr = ""
If UBound(sp) >= 1 Then sCurr = sp(1)
aOut(LiG, UBound(aOut, 2)) = sCurr Je lance mon nouveau script puis avec l'aide du méssage box je fais apparaitre le contenu extrait des céllules :
Si je lance tel quel mon VBA il se bloque ( mon problème de départ ) , c'est donc bien lié au formatage qui n'est plus adapté
Est ce le symbole - ou + de début de ligne qui pose problème et que je dois traiter dans le formatage ?
ou l'une de ces 3 actions de mise en forme qui ne colle pas ?
Merci d'avance pour l'aide que vous pourrez m'apporter
Re,
Excusez-moi c'est assez difficile à suivre juste en regardant des bouts de code…
Cependant l'erreur que vous avez n'a rien à voir avec un quelconque formatage : l'erreur 9, vous indique ici que le tableau "aOut" a un problème avec l'instruction :
aOut(LiG, E)
Donc soit le numéro de ligne (LiG) est incorrect, soit c'est celui de colonne (E). Vérifiez ces valeurs par rapport aux dimensions du tableau/matrice "aOut".
N'oubliez pas que le script initial est étroitement lié à la structure du tableau source. Si vous le changez, il y a probablement beaucoup de modifications à faire en plus de simplement changer son nom.
Bonjour,
De ce que je vois, le tableau de base, lu dans "TRS" contient 14 lignes. Hors votre tableau d'export (aOut) n'a que 7 colonnes. Donc dans la boucle For trl = 1 To TRS.Length – 1, qui lit tous les éléments du tableau TRS, il y a un problème quand on arrive à la 8e ligne, qui ne rentre plus dans les colonnes de aOut.
Après moi je n'y connais pas grand-chose à ce type de code, je vous conseille de demander à celui qui vous l'a écrit comment l'adapter parce que c'est assez particulier comme procédure.
Bonjour,
Ici:
b renvoi vrai si le dernier caractère de droite est "%"
dans la ligne surlignée en jaune, que vient faire b dans cette partie:
CDbl(Replace(Left(sp(0), Len(sp(0)) + b), ",", "."))
Bonjour à tous,
Il ne faut pas faire la conversion "," vers "." avec Cdbl()
sp(0) peut être vide il va falloir tester cette condition...
Je dois m’occuper d'autre chose si j'ai du temps ce soir j'y replonge. En attendant voici le code modifier, mais qui plante si sp(0) est vide.
Sub m_RISK()
'Dim sCurr
Dim LO As Variant
Set LO = Range("tb_RISK").ListObject 'avec un tableau structuré excel, il ne faut plus spécifier la feuille
Dim tbl As Variant
tbl = Range("tb_RISK").Resize(, 7).Value 'selection les 7 premières colonnes du tableau excel
Dim aOut As Variant
ReDim aOut(1 To UBound(tbl), 1 To 7) 'on écrit vers cette matrice temporaire (qui est vide pour commencer), un tableau à 7 colonnes
Dim LiG As Variant
For LiG = 1 To UBound(tbl) ' Boucle sur chaque lignes du tableau Excel
Dim UrL As String
UrL = tbl(LiG, 3) 'On indique que la variable URL est la 3eme colonne du tableau
Application.StatusBar = LiG & " des " & UBound(tbl) & ", Téléchargement des données de : " & tbl(LiG, 1) ' voir l'avencement , indique le nom de l'action de la cellule 1
Dim Codehtml As Variant
Codehtml = GetHtmlcode(UrL) ' telecharge le code Html de la page web corespondant a URL
With CreateObject("htmlfile") ' creer un objet HTML qui contient toute la page de l'url
.body.innerhtml = Codehtml
Dim TableHtmL As Variant
Set TableHtmL = Nothing ' initialisation - aucun tableau selectioné pour l'instant
Dim oTable As Variant
For Each oTable In .getelementsbytagname("TABLE") 'boucler chaque tableau
If InStr(1, oTable.innertext, "Janvier ") > 0 Then Set TableHtmL = oTable ' on selectione le tableau qui contient ce texte parmis tous les tableaux de la page
Next oTable ' on passe la prochaine URL et on recommence à chercher le tableau qui contient ..
If Not TableHtmL Is Nothing Then
Dim s As Variant
s = Application.StatusBar ' sauvegarde le text affiché dans la barre statut
Dim TRS As Variant
Set TRS = TableHtmL.getelementsbytagname("TR") ' récupere toutes les lignes du tableau html
Dim E As Variant
E = 0 ' compteur de colonne dans la matrice de sortie
For trl = 1 To TRS.Length - 1 ' boucle les lignes du tableau html , sauf la premiere ( souvent l'entete )
Dim A As Variant
A = 3 ' nombre de colonnes à lire dans chaque ligne html
Dim C As Variant
For C = 1 To 3 ' boucle sur les 3 premiere cellules de chaque ligne
E = E + 1 ' incrémente le compteur de colonnes
Dim sp As Variant
' Debug.Print "" 'Pour les tests
' Debug.Print TRS(trl).Cells(C).uniqueId 'Pour les tests
sp = Split(Trim(TRS(trl).Cells(C).innertext)) 'sépare le texte des cellules en mots
Application.StatusBar = s & " " & E & " " & sp(0) ' on affiche la progression avec les split pour une meilleurs lisibilitée
attendre
Debug.Print TRS(trl).innertext
Dim b As Variant
b = (Right(sp(0), 1) = "%") ' vérifi si la valeur se termine par un pourcentage
If InStr(1, sp(0), "+") Then sp(0) = Replace(sp(0), "+", vbNullString, 1, -1, vbTextCompare)
If InStr(1, sp(0), "%") Then sp(0) = Replace(sp(0), "%", vbNullString, 1, -1, vbTextCompare)
'sp(0) = Replace(sp(0), ",", ".", 1, -1, vbTextCompare)
sp(0) = Trim(sp(0))
Debug.Print "After replace % sp0 = "; sp(0)
ReDim Preserve aOut(1 To UBound(tbl), 1 To E)
If sp(0) > vbNullString Then aOut(LiG, E) = CDbl(sp(0)) * IIf(b = True, 0.01, 1) ' converti la valeur en nombre , remplace la virgule par un point , divise par 100 si c'est un pourcentage
Next
Next
End If
End With
Next
LO.ListColumns("variation").DataBodyRange.Resize(, 13).Value = aOut ' ecrit les données extraites dans le tableau excel
Application.StatusBar = False
End SubBonjour ,
avec l'aide des messagesbox j'arrve à voir les étapes , lorsque il tombe sur une cellule VIDE il n'arrive pas à faire le split
il faudrait que j'arrive à mettre une condition
Re,
Attention aux noms de colonnes...Il est préférable d'initialiser les tableaux dans un module pour éviter les erreurs de nom, pareil pour les colonnes.
Le code révisé doit faire le job. A voir maintenant pour nommer les colonnes...
Sub m_RISK()
'Dim sCurr
Dim LO As Variant
Set LO = Range("tb_RISK").ListObject 'avec un tableau structuré excel, il ne faut plus spécifier la feuille
Dim tbl As Variant
tbl = Range("tb_RISK").Resize(, 7).Value 'selection les 7 premières colonnes du tableau excel
Dim aOut As Variant
ReDim aOut(1 To UBound(tbl), 1 To 7) 'on écrit vers cette matrice temporaire (qui est vide pour commencer), un tableau à 7 colonnes
Dim LiG As Variant
For LiG = 1 To UBound(tbl) ' Boucle sur chaque lignes du tableau Excel
Dim UrL As String
UrL = tbl(LiG, 3) 'On indique que la variable URL est la 3eme colonne du tableau
Application.StatusBar = LiG & " des " & UBound(tbl) & ", Téléchargement des données de : " & tbl(LiG, 1) ' voir l'avencement , indique le nom de l'action de la cellule 1
Dim Codehtml As Variant
Codehtml = GetHtmlcode(UrL) ' telecharge le code Html de la page web corespondant a URL
With CreateObject("htmlfile") ' creer un objet HTML qui contient toute la page de l'url
.body.innerhtml = Codehtml
Dim TableHtmL As Variant
Set TableHtmL = Nothing ' initialisation - aucun tableau selectioné pour l'instant
Dim oTable As Variant
For Each oTable In .getelementsbytagname("TABLE") 'boucler chaque tableau
If InStr(1, oTable.innertext, "Janvier ") > 0 Then Set TableHtmL = oTable ' on selectione le tableau qui contient ce texte parmis tous les tableaux de la page
Next oTable ' on passe la prochaine URL et on recommence à chercher le tableau qui contient ..
If Not TableHtmL Is Nothing Then
Dim s As Variant
s = Application.StatusBar ' sauvegarde le text affiché dans la barre statut
Dim TRS As Variant
Set TRS = TableHtmL.getelementsbytagname("TR") ' récupere toutes les lignes du tableau html
Dim E As Variant
E = 0 ' compteur de colonne dans la matrice de sortie
For trl = 1 To TRS.Length - 1 ' boucle les lignes du tableau html , sauf la premiere ( souvent l'entete )
Dim A As Variant
A = 3 ' nombre de colonnes à lire dans chaque ligne html
Dim C As Variant
For C = 1 To 3 ' boucle sur les 3 premiere cellules de chaque ligne
If Trim(TRS(trl).Cells(C).innertext) > vbNullString Then '<--------------------------------- CHANGEMENT ICI
E = E + 1 ' incrémente le compteur de colonnes
Dim sp As Variant
' Debug.Print "" 'Pour les tests
' Debug.Print TRS(trl).Cells(C).uniqueId 'Pour les tests
sp = Split(Trim(TRS(trl).Cells(C).innertext)) 'sépare le texte des cellules en mots
Application.StatusBar = s & " " & E & " " & sp(0) ' on affiche la progression avec les split pour une meilleurs lisibilitée
attendre
Debug.Print TRS(trl).innertext
Dim b As Variant
b = (Right(sp(0), 1) = "%") ' vérifi si la valeur se termine par un pourcentage
If InStr(1, sp(0), "+") Then sp(0) = Replace(sp(0), "+", vbNullString, 1, -1, vbTextCompare)
If InStr(1, sp(0), "%") Then sp(0) = Replace(sp(0), "%", vbNullString, 1, -1, vbTextCompare)
'sp(0) = Replace(sp(0), ",", ".", 1, -1, vbTextCompare)
sp(0) = Trim(sp(0))
Debug.Print "After replace % sp0 = "; sp(0)
ReDim Preserve aOut(1 To UBound(tbl), 1 To E)
If sp(0) > vbNullString Then aOut(LiG, E) = CDbl(sp(0)) * IIf(b = True, 0.01, 1) ' converti la valeur en nombre , remplace la virgule par un point , divise par 100 si c'est un pourcentage
End If '<--------------------------------- CHANGEMENT ICI
Next
Next
End If
End With
Next
LO.ListColumns("variation1A").DataBodyRange.Resize(, UBound(aOut, 2)).Value = aOut '<---------------------------------CHANGEMENT ICI écrit les données extraites dans le tableau excel
Application.StatusBar = False
End SubBonjour Jean-Paul,
Merci à vous .
Je suis effectivement dans la même condition , mon script fonctionne bien
mais si je SPLIT lorsque la cellule est vide c'est la qu'il boque , je creuse coté condition du coup :-)
Merci , je tentais justement de l'écrire mais c'est compliqué pour moi :-)
il bloque toujours ici :
... Ca fonctionne maintenant lorsque j'active votre SPLIT
'sp(0) = Replace(sp(0), ",", ".", 1, -1, vbTextCompare)
sp(0) = Replace(sp(0), ",", ".", 1, -1, vbTextCompare)Pour le moment je n'ai que la deuxième ligne mais la c'est un autre problème
Pour info il rempli bien la première colonne mais n'écrit que la dernière ligne complète à chaque fois ....
certains liens également renvoient une information qui ne plait pas au SPLIT
c'est parce qu'il trouve une ligne totalement vide
c'est ok pour toutes les lignes
j'ai commenté cette ligne et maintenant c'est ok :
' ReDim Preserve aOut(1 To UBound(tbl), 1 To E)
Me reste plus que mes lignes vides à traiter :-)