Rapport de message :*
 

Re: Extraction de données sur pages web

Titre du sujet : Re: Extraction de données sur pages web
par myDearFriend! le 07/10/2009 20:42:53

Bonsoir Icedarts, le Forum,

Ok, vu pour le problème de couleur, voici comment rectifier le tir :

Option Explicit
'----------------------------------------------------------------------------
' Auteur    : Didier FOURGEOT (myDearFriend!)  -  www.mdf-xlpages.com
'----------------------------------------------------------------------------
Public EnCours As Boolean       'Flag pour contrôle de chargement page Web

Sub Traitement()
Dim TabTemp As Variant
Dim T As String, T1 As String, T2 As String
Dim L As Long, L2 As Long, Lign As Long
Dim Col As Byte
    'On efface les données de la Feuil2
    With Sheets("Feuil2")
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 12)).Delete
    End With
    'Traitement
    With Sheets("Feuil1")
        'Pour chaque lien
        For L = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            'On affiche la page Web dans le WebBrowser
            EnCours = True
            .WebBrowser1.Navigate .Cells(L, 1).Text
            'Le flag "EnCours" est remis à False dans Feuil1 > WebBrowser1_DocumentComplete()
            Do
                DoEvents
            Loop Until EnCours = False
            '
            T = .WebBrowser1.Document.Body.InnerText()
            T1 = "Matchs Class.GR Class.Opé Games PPD.301 MPR.CRI Moy/match "
            T2 = Replace(T1, " ", vbCrLf)
            T = Replace(T, T1, T2)
            'On récupère les données de chaque tableau
            TabTemp = Split(T, vbCrLf)
            Col = 0
            With Sheets("Feuil2")
                'Prochaine ligne "résultat"
                Lign = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(Lign, 14) = Mid(TabTemp(2), 1)  'Groupe
                'Données du tableau
                For L2 = 3 To UBound(TabTemp)
                    Col = Col + 1
                    If Col > 9 Then
                        Col = 1
                        Lign = Lign + 1
                        .Cells(Lign, 14) = Mid(TabTemp(2), 1)  'Groupe
                    End If
                    If TabTemp(L2) Like "Equipe :*" Then
                        .Range(.Cells(Lign, 1), .Cells(Lign, 8)).Interior.ColorIndex = IIf(TabTemp(L2 + 1) = "Matchs", 3, 33)
                    End If
                    .Cells(Lign, Col).Value = TabTemp(L2)
                Next L2
            End With
        Next L
    End With
    Sheets("Feuil2").Columns("A:H").EntireColumn.AutoFit
    MsgBox "Traitement terminé !"
End Sub

Pense à clore ce fil de discussions si tu penses que le problème est résolu (voir au bas de ma signature).

Cordialement,