Ouvrir une page web et récupérer les données d'un tableau
#1
Régulier XLPages

Inscription: 02/10/2008

Messages: 56

Système d'exploitation:
PC
Version Excel utilisée:
365
Posté le : 04-03-2023 18h10

Bonjour à tous,

Il y a une quinzaine d'années j'ai fait une demande un peu similaire.
J'ai retrouver les discussions et les anciens classeurs mais il semble que certaines valeurs dans les codes ne soient plus correct, j'ai notamment une erreur avec webbrowser.

Voila ce que je souhaite faire.
Dans le classeur joint vous verrez en page 1 une liste de lien.
Liste réduite a 5 pour les tests mais en finalité il devrait y en avoir des dizaines
Le code doit cliquer sur chaque lien pour ouvrir une page web
Sur cette page il n'y a qu'un tableau
Je souhaite que les données de chaque tableau soit accumuler en page 2 du classeur.

Merci d'avance pour votre aide.

Pièce jointe:
xlsx test.xlsx   [ Taille: 11.76 Ko - Téléchargements: 105 ]
Hors Ligne
Rapport   Haut 

Re: Ouvrir une page web et récupérer les données d'un tableau
#2
Webmestre

Inscription: 18/05/2006
De Saône-et-Loire (71)

Messages: 1539

Système d'exploitation:
PC
Version Excel utilisée:
97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365
Posté le : 04-03-2023 20h35

Bonsoir Icedarts, le Forum,

 

Tu trouveras en pièce-jointe sans doute une façon de faire :

 

DANS UN MODULE DE CODE STANDARD (ex : Module1)

Option Explicit

Sub RecupDatas()
' myDearFriend! - www.mdf-xlpages.com
' Mars 2023

' Nécessite une référence à "Microsoft HTML Object Library"
Dim vTabLiens As Variant
Dim iDoc As New MSHTML.HTMLDocument
Dim TabDoc As HTMLTable
Dim Lnk As Long, NbLignTab As Long, Lmax As Long, L As Long
Dim NbColTab As Byte, C As Byte
    'Liste des liens
    vTabLiens = Sheets("Liens").Cells(1, 1).CurrentRegion.Value
    'Pour chaque lien
    For Lnk = 1 To UBound(vTabLiens, 1)
        'Récup table datas
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", vTabLiens(Lnk, 1), False
            .send
            iDoc.body.innerHTML = .responseText
        End With
        Set TabDoc = iDoc.getElementById("tableSort")
        
        NbLignTab = TabDoc.Rows.Length - 1
        NbColTab = TabDoc.Rows(0).Cells.Length - 1
        
        'Complétude du tableau
        With Sheets("Données")
            For L = 1 To NbLignTab
                For C = 0 To NbColTab
                    .Cells(Lmax + L + 1, C + 1).Value = TabDoc.Rows(L).Cells(C).innerText
                Next C
            Next L
        End With
        Lmax = Lmax + NbLignTab
    Next Lnk
    
    MsgBox "Récup terminée !"
    
    Set TabDoc = Nothing
    Set iDoc = Nothing
End Sub

Nb : tu n'as pas besoin de faire usage d'un webBrowser pour le fonctionnement de ce code.

 

En espérant t'avoir aidé.

 

Bien cordialement,

 

Pièce jointe:
xlsm PourIcedarts.xlsm   [ Taille: 22.26 Ko - Téléchargements: 114 ]

Didier_mDF
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
Rapport   Haut 

Re: Ouvrir une page web et récupérer les données d'un tableau
#3
Régulier XLPages

Inscription: 02/10/2008

Messages: 56

Système d'exploitation:
PC
Version Excel utilisée:
365
Posté le : 06-03-2023 10h53

Bonjour,

Merci ça répond exactement à mes attentes.
Juste une chose car je n'avais pas pensé aux doublons d'un lien à l'autre.

 

J'ai donc ajouter une colonne en page 1 avec une info pour chaque lien.
Est-il possible de rajouter cette info sur chaque ligne dans la page 2

Le lien 1 on récupère X lignes on ajoute l'info sur ces X lignes

On passe au lien 2 on ajoute l'info du lien 2 sur les X nouvelles lignes etc etc.

Exemple en pièce jointe ça sera plus explicite ^^

 

Merci d'avance.

Pièce jointe:
xlsm PourIcedarts.xlsm   [ Taille: 26.83 Ko - Téléchargements: 107 ]
Hors Ligne
Rapport   Haut 

Re: Ouvrir une page web et récupérer les données d'un tableau
#4
Webmestre

Inscription: 18/05/2006
De Saône-et-Loire (71)

Messages: 1539

Système d'exploitation:
PC
Version Excel utilisée:
97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365
Posté le : 07-03-2023 21h08

Bonsoir Icedarts, le Forum,

 

En modifiant une partie du code précèdent comme suit (en rouge), ça devrait suffire pour répondre à cette nouvelle demande :

       'Complétude du tableau
        With Sheets("Données")
            For L = 1 To NbLignTab
                For C = 0 To NbColTab
                    With .Cells(Lmax + L + 1, C + 1)
                        .Value = TabDoc.Rows(L).Cells(C).innerText
                        If C = NbColTab Then
                            .Offset(0, 1).Value = vTabLiens(Lnk, 2)
                        End If
                    End With
                Next C
            Next L
        End With

En pièce jointe, le code en action.

 

Bien cordialement,

Pièce jointe:
xlsm PourIcedarts2.xlsm   [ Taille: 23.35 Ko - Téléchargements: 107 ]

Didier_mDF
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
Rapport   Haut 

Re: Ouvrir une page web et récupérer les données d'un tableau
#5
Régulier XLPages

Inscription: 02/10/2008

Messages: 56

Système d'exploitation:
PC
Version Excel utilisée:
365
Posté le : 07-03-2023 21h14

Merci beaucoup c'est parfait.

Hors Ligne
Rapport   Haut 

Re: Ouvrir une page web et récupérer les données d'un tableau
#6
Régulier XLPages

Inscription: 02/10/2008

Messages: 56

Système d'exploitation:
PC
Version Excel utilisée:
365
Posté le : 25-05-2023 11h47

Citation :

myDearFriend! a écrit :

Bonsoir Icedarts, le Forum,

 

En modifiant une partie du code précèdent comme suit (en rouge), ça devrait suffire pour répondre à cette nouvelle demande :

       'Complétude du tableau
        With Sheets("Données")
            For L = 1 To NbLignTab
                For C = 0 To NbColTab
                    With .Cells(Lmax + L + 1, C + 1)
                        .Value = TabDoc.Rows(L).Cells(C).innerText
                        If C = NbColTab Then
                            .Offset(0, 1).Value = vTabLiens(Lnk, 2)
                        End If
                    End With
                Next C
            Next L
        End With

En pièce jointe, le code en action.

 

Bien cordialement,

 

Bonjour,

 

J'essaie de poster ici car je n'arrive pas a créer de sujet.
Il y a un problème avec le forum?

Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes