Concernant les resultats est ce que je peux pas avoir les cours historiques genre sur un mois (1) et aussi aux niveau des variations je pense que ca ne retrouve pas ce champ sur le site(2). Au pire je peux automatiser ce calcul des variations de cours ?
peux-tu me dire où je peux trouver ces valeurs sur un mois ? sinon par interrogations régulières la base de données va se compléter au fur et a mesure
je vais ajouter les variations
Et aussi pourrais tu ajouter quelques commentaires sur le code ca me permettrait aussi d'apprendre et de mieux le comprendre.
Sub Maj()
Dim URL$, obj As New DataObject, sh As Worksheet
' suppression anciennes feuilles
' je désactive les alertes, sinon excel me demandra si je suis sûr d vouloir supprimer la feuille
Application.DisplayAlerts = False
' pour toutes les feuilles
For Each sh In Worksheets
' si leur nom ne commence pas par un underscore que je réserve aux feuilles permanentes alors je les supprime
If Left(sh.Name, 1) <> "_" Then sh.Delete
Next
Application.DisplayAlerts = True
' ce terme me permet de sélectionner le bon tablau historique du cours de la page
avant = "<table class=""c-table c-table--generic"" data-table-sorter>"
' i sera le numéro de ligne, depuis 1 jusqu'à la dernière ligne rensignée de la colonne C
' on part en fait de la dernière cellule de C avec rows.count qui signifie le nombre total de lignes pour excel
' et on remonte par end(xlup) jusqu'à celle rensignée dont on prend le numéro de ligne ou row
For i = 1 To Sheets("_URL").Range("C" & Rows.Count).End(xlUp).Row
' instructions classiques dans le cas d'un interrogation web
DoEvents
URL = Sheets("_URL").Range("C" & i)
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
' Le code de statut de réponse HTTP 200 OK indique la réussite d'une requête
If .Status = 200 Then
' je découpe la réponse pour en extraire le tableau
' première découpe avec le critère défini ci-dssus ... j'en prend la seconde partie (indice 1)
' duxième découpe avec </table> dont je prends la première partie (indoce 0)
' et je rajoute les balises <table... et </table>
txt = avant & Split(Split(.responseText, avant)(1), "</table>")(0) & "</table>"
' j'ajoute une apostrophe devant les dates pour les préserver et éviter qu'excel n'en fasse ce qu'il veut
txt = Replace(txt, "u-text-uppercase"">", "u-text-uppercase"">'") ' préservation de la date FR
' je colle cela dans le press-papier
obj.SetText txt
obj.PutInClipboard
' j'ajoute une feuille
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
' je colle le tablau dans la feuille (excel sait reconnaître qu'il s'agit d'un tableau d données html)
ActiveSheet.Paste
' je donne le nom de la valeur à la feuille
ActiveSheet.Name = Sheets("_URL").Range("A" & i)
End If
End With
Next
' maintenant je vais contruire ou compléter ma base de données en allant chercher les informations dans chaqu feuille ne commençant pas par underscore
With Sheets("_data")
For Each sh In Worksheets
If Left(sh.Name, 1) <> "_" Then
' dernière ligne rensignée plus une (donc première ligne vierge)
ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
' je balaye toutes les colonnes du tableau aspiré
For i = 2 To sh.Cells(1, Columns.Count).End(xlToLeft).Column
' nom d la valeur
.Cells(ligne, 1) = sh.Name
' date de cotation avec invention de l'année qui n'est pas mentionnée sur le site !
.Cells(ligne, 2) = DateSerial(Year(Now), Right(sh.Cells(1, i), 2), Mid(sh.Cells(1, i), 2, 2))
If .Cells(ligne, 2) > Now Then .Cells(ligne, 2) = DateSerial(Year(Now) - 1, Right(sh.Cells(1, i), 2), Mid(sh.Cells(1, i), 2, 2))
' cotation en remplaçant le point par virgule
.Cells(ligne, 3) = Replace(sh.Cells(2, i), ".", ",") * 1
' ligne suivante
ligne = ligne + 1
Next i
End If
Next
' suppression des doublons si une valeur a déjà été chargée pour le mêm jour
.Range("Tableau1[#Tout]").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End With
' mise à jour du TCD
Sheets("_histo").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
End Sub