Importer des données depuis ma page perso
Bonjour a toutes et a tous
J'ai un fichier excel qui importe un tableau sur ma page perso, seulement il importe que les lignes principales et je souhaiterais qu'il importe toute la page complète (cela comprend les interlignes dépliables dans le tableau).
Il faudrait un peu modifier le module "recettes" et je demande votre aide.
Merci a vous
Bonjour,
première façon simple et rapide est de lire en bloc le tableau complet de la page html avec cet outil https://www.excel-pratique.com/fr/telechargements/macros/tables-html-site-excel-no432
Adaptation du code ...
Sub Maj()
Dim URL$, obj As New DataObject
On Error Resume Next
DoEvents
URL = [www]
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
For i = 1 To UBound(Split(.responseText, "<table"))
txt = "<table" & Split(Split(.responseText, "<table")(i), "</table>")(0) & "</table>"
txt = Replace(txt, "colspan=""15""", "")
txt = Replace(txt, "<p>", "<tr><td>")
txt = Replace(txt, "</p>", "</td></tr>")
obj.SetText txt
obj.PutInClipboard
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Columns("A:B").ColumnWidth = 25
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
ActiveSheet.Paste
'ActiveSheet.Name = "Table #" & i
debut = 3
For j = debut To Cells(Rows.Count, 1).End(xlUp).Row + 1
If Cells(j, 1) = "" Then Rows(debut & ":" & j - 1).Rows.Group: Exit For
If Cells(j, 2) <> "" Then Rows(debut & ":" & j - 1).Rows.Group: debut = j + 1
Next
Next
End If
End With
MsgBox "Fin !"
End SubMerci beaucoup Steelson cela fonctionne par contre j'aurais juste voulu conserver mon format de fichier (macro) et juste changer le petit morceau que j'ai entouré de vert car par la suite j'aurais d'autre lien sur la même feuille et j'aurais besoin qu'il me fasse la différence entre chaque lien. Pour cela il se sert de la feuille Index pour allez chercher le 1er lien en C3 et qu'il colle dans la feuille Temp et ainsi de suite C4 c'est dans ce sens là que je veux que la macro fonctionne car là il m'ouvre une nouvelle feuille a chaque fois.
Est-ce que tu peux récupérer les infos de chaque feuille et les rapatrier dans ta feuille principale ?
La méthode utilisée ici est une méthode globale qui va récupérer toute la table de la page html. Donc de toute façon il faut ensuite décortiquer les infos dont on a alors besoin.
Sinon montre moi comment tu veux que les informations soient stockées dans ton fichier en final.
Qu'il soit stocké pareil que ton fichier, il y a toutes les lignes mais dans la feuille Temp et qu'il passe par la feuille Index pour aller chercher le premier lien en C3.
Ensuite pour le stockage pour le moment qu'il le laisse juste sur la Feuil Temp
Car j'ai pas compris comment il va chercher le lien dans ta macro car si je met le lien n'importe ou dans la Feuille URL ça fonctionne quand même !
Le lien est dans la macro trouvé directement dans une cellule nommée www
URL = [www]je vais donc prendre ce que tu as mis pour détecter le lien hypertexte et stocker les données dans temp
Merci Steelson cela me conviens mieux, juste une petite chose si à la place de <table je voudrais récupérer que ce qu'il y a dans <tbody cela serais quoi le changement ?
Sinon je voulais savoir a quoi ça correspond, c'est 200 quoi ?
If .Status = 200 ThenMerci Steelson cela me conviens mieux, juste une petite chose si à la place de <table je voudrais récupérer que ce qu'il y a dans <tbody cela serais quoi le changement ?
Non cela ne fonctionnerait pas ! L'astuce ici est de mettre un texte qui commence par <table .... et finit par </Table> dans le presse-papier et ensuite le coller dans excel qui justement interprété bien les tables/tableaux html.
Ce serait beaucoup plus complexe avec tbody ... sauf à remplacer le terme tbody par table avant de le copier dans le presse papier
txt = Replace(txt, "tbody", "table")
obj.SetText txt
obj.PutInClipboardEt ça va pas poser de problème s'il y a deux fois table ?
Tu as raison, il faut aussi changer ceci
txt = "<table" & Split(Split(.responseText, "<table")(i), "</table>")(0) & "</table>"en
txt = "<tbody" & Split(Split(.responseText, "<tbody")(i), "</tbody>")(0) & "</tbody>"très probablement (à tester)
Voilà j'ai pris directement tout dans le <body> et ensuite je fais le gros ménage (suppression des liens, images, sharp ...) pour garder ce que je voulais garder, donc j'ai rajouté un peu de code en dessous du tient.
J'ai crée 3 pages html elles sont identique mais c'est pour l'exemple, il y en aura plus après, le but de la manœuvre serait qu'il check en premier C3 de Feuil index pour importer dans Feuil Temp et ensuite qu'il me colle ça dans la Feuil Dessert ensuite il passe a la cellule C4 et idem il me colle ça dans Feuil Temp et ensuite à la suite de Dessert et ça devra donner le résultat qu'il y a déjà dans Feuil Dessert. En passant s'il pouvait rajouter le nom de la page C3, C4 etc en Feuil Dessert colonne B.
Voici le nouveau fichier modifié
le but de la manœuvre serait qu'il check en premier C3 de Feuil index pour importer dans Feuil Temp et ensuite qu'il me colle ça dans la Feuil Dessert ensuite il passe a la cellule C4 et idem il me colle ça dans Feuil Temp et ensuite à la suite de Dessert et ça devra donner le résultat qu'il y a déjà dans Feuil Dessert. En passant s'il pouvait rajouter le nom de la page C3, C4 etc en Feuil Dessert colonne B.
pourquoi passer par temp ?
ensuite, quelle est l forme finale ? peux-tu faire un exemple ?
On passe par Temp car faut qu'il importe et nettoie la feuille et ensuite il colle ça dans l'autre feuille Dessert bien propre et il fait pareil pour les autres liens et le resultat c'est ce qu'il y aura dans Feuille Dessert.
L'exemple serait ceci dans index je mettrais les liens et il devra importer dans leurs feuilles de destination Dessert 1, Dessert 2 etc la les liens et leurs contenu sont identique mais seront différent après.
Je ne retrouve pas dans ton exemple les lignes que tu souhaitais faire apparaître ...
J'ai un fichier excel qui importe un tableau sur ma page perso, seulement il importe que les lignes principales et je souhaiterais qu'il importe toute la page complète (cela comprend les interlignes dépliables dans le tableau).
J'en reste donc à ma question
ensuite, quelle est la forme finale ? peux-tu faire un exemple ?
sinon, le contrat initial d'importer les ""interlignes dépliables" est rempli.
Pour revenir sur tbody, la page n'est pas conforme car on trouve la fermeture de la balise table avant celle de tbody.
<table class="tableauLine" id="fc_table_recettes">
<thead class="tableauLineNoir">
<tr class="nowrap">
</tr>
</thead>
<tbody>
<tr class=" ficheTabColorImpair nowrap" onclick="javascript: afficheClassement('357628');" id="hautClassement357628">
</tr></table>
</tbody>Sinon oui le contrat est rempli
Et pour répondre a tbody je me suis aperçu que ça n'allait pas c'est donc pour ça que j'ai pris le body complet et faire le nettoyage ensuite
Donc pour répondre a ta question ceci serait le fichier final mais il ne fonctionne pas correctement (problème de If mal placé ou de end with etc) j'ai réussi a le faire fonctionner juste que sur le dernier lien mais je n'y arrive plus lol. Je change je rechange je test mais ça coince.
Donc j'ai besoin de ton aide pour finaliser ce fichier si qui devrait fonctionner tous le code est dedans mais doit y avoir des choses a corriger, même le retour à la ligne en mode false ça fonctionne pas, il y a le code mais ça marche pas.
Ton fichier ne reprend pas du tout la macro que je t'ai proposée ! Le code dont tu parles ne fonctionne pas car le getelementbyid n'est pas adapté aux composants.
Ton fichier ne reprend pas non plus dans la présentation finale (que je t'avais demandée pour comprendre où tu voulais aller) les "interlignes dépliables" comme tu les appelais !
Donc je suis désolé mais je m'arrête là ... tu as la macro qui reprend toutes les données ici : https://forum.excel-pratique.com/excel/importer-des-donnees-depuis-ma-page-perso-146263#p899718
Pourquoi tu parles de getelementbyid dans le dernier fichier j'ai gardé le code que tu m'a donné il n'y aucun getelementByid !
Sub Lire_Recettes()
Dim URL$, obj As New DataObject
Dim img As Object
Dim ws As Worksheet, Cel As Range
Dim A() As Variant
Dim nomRe As String, nbRe As Byte, numRe As Byte
Dim nomRcet As String, nbRcet As String, Temp As String
On Error Resume Next
Application.ScreenUpdating = False
'Vide - Feuilles Dessert
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "Dessert*" Then _
ws.[A1].CurrentRegion.Offset(1).ClearContents
Next ws
'Boucle - Liste des noms
With F04
.Activate
Cells.Delete
nbRcet = Val(Right(F03.Cells(F03.[A500].End(xlUp).Row, 1), 2))
For Each Cel In F03.Range("C3:C" & F03.[C500].End(xlUp).Row)
If CBool(Cel.Hyperlinks.Count) Then
nomRe = Cel: nomRcet = Cel.Offset(, -2):
numRe = Val(Cel.Offset(, -1)): nbRe = Val(Cel.Offset(, 3))
URL = Cel.Hyperlinks(1).Address
Application.StatusBar = "Extraction : " & nomRcet & " de " & nbRcet & " - Cheval " & numRe & " de " & nbRe
Cells.Delete
'''''''''''''''''''''''''''''''''''''''''''''''''''' TON CODE EST BIEN LA ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
'If .Status = 200 Then
For i = 1 To UBound(Split(.responseText, "<body"))
txt = "<body" & Split(Split(.responseText, "<body")(i), "</body>")(0) & "</body>"
'txt = Replace(txt, "colspan=""15""", "")
'txt = Replace(txt, "<p>", "<tr><td>")
'txt = Replace(txt, "</p>", "</td></tr>")
obj.SetText txt
obj.PutInClipboard
F04.Cells.Clear
With F04.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlLeft
.IndentLevel = 0
End With
F04.Paste
'debut = 3
'For j = debut To F04.Cells(Rows.Count, 1).End(xlUp).Row + 1
'If F04.Cells(j, 1) = "" Then F04.Rows(debut & ":" & j - 1).Rows.Group: Exit For
'If F04.Cells(j, 2) <> "" Then F04.Rows(debut & ":" & j - 1).Rows.Group: debut = j + 1
'Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Worksheets("Temp").Activate
Cells.Select
For Each img In ActiveSheet.Pictures
img.Delete
Next img
For Each img In ActiveSheet.Shapes
img.Delete
Next
Cells.Select
'''''''''''''''
'''''''''''''''
'supprime toute les lignes sans [+-]
For j = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Not Cells(j, 15) Like "*[+-]*" Then Rows(j).Delete
Next
'supprime les hyperliens
Cells.Select
With Selection
.Hyperlinks.Delete
End With
'supprime ligne 1
Rows("1").Delete
'supprime le retour à la ligne
Range("A1:A").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Columns("F").Delete
Columns("B").Insert
Columns("P").Delete
Columns("A:R").AutoFit
Range("B1:B" & [A500].End(xlUp).Row) = nomRe
'Copie données vers feuille Dessert x
Lig = Sheets(nomRcet).[A65000].End(xlUp).Row + 1
[A1].Resize([A500].End(xlUp).Row, 15).Copy Sheets(nomRcet).Cells(Lig, "A")
Cells.Delete
End If
Next Cel
Application.StatusBar = ""
End With
F04.Select
End Sub