Lire un tableau dans une page Internet

Version imprimable

13/09/2012, 10h19
Nonno 94

Lire un tableau dans une page Internet

Bonjour le Forum,:oops:

ne parvenant pas à le faire, je viens solliciter votre aide pour compléter un code qui me permettra de lire un tableau Internet.

Le code que j'utilise actuellement me permet seulement de lire la 1 ère ligne "ACCOR" de ce tableau.
Je suppose que pour lire l'intégralité de ce tableau jusqu'à la ligne "DASSAULT SYSTEMES", il faut ajouter une seconde boucle ce que je ne sais pas faire.
Pouvez-vous m'indiquer comment faire ?

Afin de mieux expliciter ma demande, je joins un fichier exemple.

Avec mes remerciements pour vos réponses et en vous souhaitant une bonne journée.
Cordialement.

Nonno 94.

Bonjour,

Peut-être comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub Lire_Tableau_SRD_Myta()
 
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Titre(2) As String, Valeur(6) As String              'Titre(2)
    Dim Cel As Range, I As Integer
    ligne = 1
    Sheets("Tableau SRD").Select
        ActiveSheet.Unprotect
 
        IE.Navigate [A2]
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document
 
        Set HtmlTag = IEDoc.getElementsByTagName("td")
 
        Titre(0) = "ACCOR": Valeur(0) = "N/A"
        For I = 0 To HtmlTag.Length - 1
 
            If HtmlTag.Item(I).innerText = Titre(0) Then
            For x = I To HtmlTag.Length - 1 Step 8
              ligne = ligne + 1
              If Left(HtmlTag.Item(x).innerHTML, 7) = "<script" Then
                I = HtmlTag.Length - 1
                Exit For
              End If
              Cells(ligne, 2) = HtmlTag.Item(x).innerText
              Cells(ligne, 3) = HtmlTag.Item(x + 1).innerText
              Cells(ligne, 4) = HtmlTag.Item(x + 2).innerText
              Cells(ligne, 5) = HtmlTag.Item(x + 3).innerText
              Cells(ligne, 6) = HtmlTag.Item(x + 4).innerText
              Cells(ligne, 7) = HtmlTag.Item(x + 5).innerText
              Cells(ligne, 8) = HtmlTag.Item(x + 6).innerText
              Cells(ligne, 9) = HtmlTag.Item(x + 7).innerText
            Next x
            End If
        Next I
 
         IE.Visible = False
 
    IE.Quit
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing
 
        Range("B1").Select
            ActiveSheet.Protect
 
                ActiveWorkbook.Save
 
End Sub

13/09/2012, 16h38
Nonno 94

Re:

Bonjour Daniel,

tous mes remerciements pour cette réponse très pertinente.
Vous auriez pu écrire ; "comme ceci" et non : "peut-être comme ceci" !!

Félicitations.
En vous souhaitant une XLlente fin de journée.
Cordialement.

Nonno 94.
13/09/2012, 17h03
Nonno 94

Nouvelle question

Re-bonjour Daniel,

pouvez-vous me dire pour quelle raison la colonne "Conseil" n'est pas lue; exception faite de la valeur "AB" en G23 ?
Existe-t-il un moyen de remédier à ce problème ?

A nouveau un grand merci pour votre code.

Nonno 94.
13/09/2012, 17h59
Nonno 94

Modification du code

Bonsoir Daniel, bonsoir le Forum,

est-il possible de faire en sorte que la 1 ère ligne lue soit celle des étiquettes des colonnes (Valeurs - Cours - Solidité - Investissement - Global - Conseil - Objectif - Potentiel) et non celle de la 1 ère valeur (ACCOR) ?

Soit :

Code:

Titre(0) = "Valeurs": Valeur(0) = "N/A"

et non :

Code:

Titre(0) = "ACCOR": Valeur(0) = "N/A"

En espérant ne pas abuser de votre patience !!!

Cordialement.
Nonno 94.

Pour ce qui est de "Conseil", ce n'est pas du texte simple (sauf pour BOURBON), mais du texte HTML. Pour l'autre question, ce sera pour demain :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub Lire_Tableau_SRD_Myta()
 
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Titre(2) As String, Valeur(6) As String              'Titre(2)
    Dim Cel As Range, I As Integer
    ligne = 1
    Sheets("Tableau SRD").Select
        ActiveSheet.Unprotect
 
        IE.Navigate [A2]
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document
 
        Set HtmlTag = IEDoc.getElementsByTagName("td")
 
        Titre(0) = "ACCOR": Valeur(0) = "N/A"
        For I = 0 To HtmlTag.Length - 1
 
            If HtmlTag.Item(I).innerText = Titre(0) Then
            For x = I To HtmlTag.Length - 1 Step 8
              ligne = ligne + 1
              If Left(HtmlTag.Item(x).innerHTML, 7) = "<script" Then
                I = HtmlTag.Length - 1
                Exit For
              End If
              Cells(ligne, 2) = HtmlTag.Item(x).innerText
              Cells(ligne, 3) = HtmlTag.Item(x + 1).innerText
              Cells(ligne, 4) = HtmlTag.Item(x + 2).innerText
              Cells(ligne, 5) = HtmlTag.Item(x + 3).innerText
              Cells(ligne, 6) = HtmlTag.Item(x + 4).innerText
              tabl = Split(HtmlTag.Item(x + 5).innerHTML, "alt=""")
              On Error Resume Next
              Cells(ligne, 7) = Split(tabl(1), """ src")(0)
              If Err.Number <> 0 Then
                Cells(ligne, 7) = HtmlTag.Item(x + 5).innerText
                Err.Clear
              End If
              Cells(ligne, 8) = HtmlTag.Item(x + 6).innerText
              Cells(ligne, 9) = HtmlTag.Item(x + 7).innerText
            Next x
            End If
        Next I
 
         IE.Visible = False
 
    IE.Quit
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing
 
        Range("B1").Select
            ActiveSheet.Protect
 
                ActiveWorkbook.Save
 
End Sub

Mieux :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub Lire_Tableau_SRD_Myta()
 
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Titre(2) As String, Valeur(6) As String              'Titre(2)
    Dim Cel As Range, I As Integer
    ligne = 1
    Sheets("Tableau SRD").Select
        ActiveSheet.Unprotect
 
        IE.Navigate [A2]
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document
 
        Set HtmlTag = IEDoc.getElementsByTagName("td")
 
        Titre(0) = "ACCOR": Valeur(0) = "N/A"
        For I = 0 To HtmlTag.Length - 1
 
            If HtmlTag.Item(I).innerText = Titre(0) Then
            For x = I To HtmlTag.Length - 1 Step 8
              ligne = ligne + 1
              If Left(HtmlTag.Item(x).innerHTML, 7) = "<script" Then
                I = HtmlTag.Length - 1
                Exit For
              End If
              Cells(ligne, 2) = HtmlTag.Item(x).innerText
              Cells(ligne, 3) = HtmlTag.Item(x + 1).innerText
              Cells(ligne, 4) = HtmlTag.Item(x + 2).innerText
              Cells(ligne, 5) = HtmlTag.Item(x + 3).innerText
              Cells(ligne, 6) = HtmlTag.Item(x + 4).innerText
              tabl = Split(HtmlTag.Item(x + 5).innerHTML, "alt=""")
              On Error Resume Next
              Cells(ligne, 7) = Split(tabl(1), """ src")(0)
              If Err.Number <> 0 Then
                Cells(ligne, 7) = HtmlTag.Item(x + 5).innerText
                Err.Clear
              End If
              On Error GoTo 0
              Cells(ligne, 8) = HtmlTag.Item(x + 6).innerText
              Cells(ligne, 9) = HtmlTag.Item(x + 7).innerText
            Next x
            End If
 
        Next I
 
         IE.Visible = False
 
    IE.Quit
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing
 
        Range("B1").Select
            ActiveSheet.Protect
 
                ActiveWorkbook.Save
 
End Sub

13/09/2012, 19h39
Nonno 94

Impressionnant !!!!

Je ne trouve pas d'autre mot.

Je vais tout de même vous souhaiter une très bonne fin de journée.
A demain.

Cordialement.
Nonno 94.

Citation:

Impressionnant !!!!

Euh... oui, attends la suite; essaie :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub Lire_Tableau_SRD_Myta()
 
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Titre(2) As String, Valeur(6) As String              'Titre(2)
    Dim Cel As Range, I As Integer
    ligne = 1
    Sheets("Tableau SRD").Select
        ActiveSheet.Unprotect
 
        IE.Navigate [A2]
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document
 
        Set HtmlTag = IEDoc.getElementsByTagName("td")
 
        Titre(0) = "Agenda": Valeur(0) = "N/A"
        For I = 0 To HtmlTag.Length - 1
 
            If HtmlTag.Item(I).innerText = Titre(0) Then
            For x = I + 1 To HtmlTag.Length - 1 Step 8
              ligne = ligne + 1
              If Left(HtmlTag.Item(x).innerHTML, 7) = "<script" Then
                I = HtmlTag.Length - 1
                Exit For
              End If
              Cells(ligne, 2) = HtmlTag.Item(x).innerText
              Cells(ligne, 3) = HtmlTag.Item(x + 1).innerText
              Cells(ligne, 4) = HtmlTag.Item(x + 2).innerText
              Cells(ligne, 5) = HtmlTag.Item(x + 3).innerText
              Cells(ligne, 6) = HtmlTag.Item(x + 4).innerText
              tabl = Split(HtmlTag.Item(x + 5).innerHTML, "alt=""")
              On Error Resume Next
              Cells(ligne, 7) = Split(tabl(1), """ src")(0)
              If Err.Number <> 0 Then
                Cells(ligne, 7) = HtmlTag.Item(x + 5).innerText
                Err.Clear
              End If
              On Error GoTo 0
              Cells(ligne, 8) = HtmlTag.Item(x + 6).innerText
              Cells(ligne, 9) = HtmlTag.Item(x + 7).innerText
            Next x
            End If
 
        Next I
 
         IE.Visible = False
 
    IE.Quit
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing
 
        Range("B1").Select
            ActiveSheet.Protect
 
                ActiveWorkbook.Save
 
End Sub

Toujours impressionné

Bonjour Daniel.C,

la suite valait effectivement la peine d'être attendue !
Vos prouesses répétées seraient-elles un encouragement à vous faire part d'un nouveau problème de "code" rencontré ce matin ?

Je pense que oui et vous expose donc celui-ci.
Pour lire des données dans des pages Internet, j'utilise le code suivant :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 Sub Lire_Valeurs_Myta_Echos() Dim IE As New InternetExplorer Dim IEDoc As HTMLDocument Dim HtmlTag As IHTMLElementCollection Dim Valeur1 As String, Valeur2 As String Dim Cel As Range, I As Integer Sheets("Valeurs Myta Echos").Select ActiveSheet.Unprotect For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) IE.Navigate Cel IE.Visible = True Do Until IE.readyState = READYSTATE_COMPLETE DoEvents Loop Set IEDoc = IE.document Set HtmlTag = IEDoc.getElementsByTagName("td") Valeur1 = "N/A": Valeur2 = "N/A" For I = 0 To HtmlTag.Length - 1 If HtmlTag.Item(I).innerText = "Cours" Then Valeur1 = HtmlTag.Item(I + 1).innerText If HtmlTag.Item(I + 4).innerText = "Ouverture" Then Valeur2 = HtmlTag.Item(I + 5).innerText End If Exit For End If Next I Cel.Offset(, 2) = Valeur1 Cel.Offset(, 3) = Valeur2 Next Cel IE.Visible = False Set HtmlTag = Nothing Set IEDoc = Nothing Set IE = Nothing IE.Visible = False Range("B1").Select ActiveSheet.Protect ActiveWorkbook.Save End Sub
dont je modifie les "innerText".

Tout va bien pour les 2 précédents dans la feuille "Valeurs Myta Echos" qui lisent les cellules "jaunes" de la page Internet "AB Science" par exemple mais les choses se "gâtent" avec ceux-ci :
Code:

1 2 3 4 5 6 7 If HtmlTag.Item(I).innerText = "Objectif de cours ?rois mois" Then Valeur1 = HtmlTag.Item(I + 1).innerText If HtmlTag.Item(I + 2).innerText = "Potentiel" Then Valeur2 = HtmlTag.Item(I + 3).innerText End If Exit For End If
dans la feuille "Valeurs Echos Myta (2)" pour cette même page Internet et ses semblables ainsi que vous pourrez le voir dans les feuilles concernées du fichier joint (AB Science, Valeurs Myta Echos et Valeurs Echos Myta (2)). Ces 2 "innerText" ne permettent pas de lire les cellules "rouges" des pages Internet concernées.

Est-ce "abuser" de ma part que de vous demander de me dire pour quelle raison le 2 ème code ne génère que des "N/A" et de m'indiquer, si cela est possible, quelle modification lui apporter pour lire les données demandées ?

Ainsi que vous m'avez conseillé de le faire, j'attends la suite !!!!
Dans l'attente et avec mes remerciements renouvelés, je vous souhaite un bon après-midi.

Cordialement.
Nonno 94

14/09/2012, 15h06
Daniel.C

C'est là que tu trouves mes limites. Je ne retrouve même pas exactement le code que tu postes. Peux-tu poster une macro prête à l'emploi ?
14/09/2012, 15h38
Nonno 94

J'ai joint un fichier au dernier message !

Je le joins à nouveau à cette réponse.
14/09/2012, 16h06
Daniel.C

Ca ne viendrait pas du "?" dans "Objectif de cours ?rois mois" ?
14/09/2012, 16h27
Nonno 94
Je ne le pense pas car il n'est pas non plus possible de lire la donnée "Potentiel" écrite "a priori" normalement.

De +, si on veut lire le Potentiel en 1 er,
Code:

1 2 If HtmlTag.Item(I).innerText = "Potentiel" Then '"Objectif de cours ?rois mois" Valeur1 = HtmlTag.Item(I + 1).innerText
la valeur obtenue est : "La valeur dans son secteur" (cellule A 155) !!

Qu'en dites-vous Monsieur "no limit" ?

Cordialement.
Nonno 94.
14/09/2012, 16h39
Daniel.C

Je trouve "Potentiel" en lançant la macro "Lire_Valeurs_Myta_Echos_2". Valeur de I : 289.
14/09/2012, 17h11
Nonno 94

Interrogations !!

Pour la valeur "AB Science",
le potentiel est de :134,10 % et
l'objectif de cours à 3 mois de : 24 €.

Voici le lien :

http://bourse.lesechos.fr/bourse/cot...PAR&codif=ISIN

Les liens des autres valeurs (les 18 premières) se trouvent dans les feuilles "Valeurs Myta Echos".

Je dois dire que je ne comprends pas !!!

J'ai "repéré" que ces données font partie du tableau 21 (.WebTables = "21") de la page des Valeurs.

ɶolution semaine =
Objectif de cours ࠴rois mois 24,00 €
Potentiel 134,10%

Existe-t-il un autre moyen de lire ces 2 données pour chaque valeur sachant que mon fichier en contient plus de 200 ?

Monsieur l'Expert, il va falloir repousser vos limites !

Cordialement.
Nonno 94.
14/09/2012, 17h43
Daniel.C

Que veux-tu que je te dise de plus ? Je trouve bien "Objectif de cours à trois mois" et "Potentiel" pour AB Science.
14/09/2012, 17h53
Qwazerty

Salut

Voila un tutoriel qui pourrait sans doute t'aider.

Tu y trouveras une fonction qui te permet de retrouver un élément via son ClassName par exemple.

A++
Qwaz

Re:

Avec ce code ? :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub Lire_Valeurs_Myta_Echos_2()
 
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur1 As String, Valeur2 As String
    Dim Cel As Range, I As Integer
 
    Sheets("Valeurs Myta Echos (2)").Select
        ActiveSheet.Unprotect
 
    For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        IE.Navigate Cel
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document
 
        Set HtmlTag = IEDoc.getElementsByTagName("td")
 
        Valeur1 = "N/A": Valeur2 = "N/A"
        For I = 0 To HtmlTag.Length - 1
            If HtmlTag.Item(I).innerText = "Objectif de cours ?rois mois" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText
              If HtmlTag.Item(I + 2).innerText = "Potentiel" Then
                Valeur2 = HtmlTag.Item(I + 3).innerText
              End If
                Exit For
            End If
        Next I
        Cel.Offset(, 2) = Valeur1
        Cel.Offset(, 3) = Valeur2
    Next Cel
 
        IE.Visible = False
 
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing
 
 
        IE.Visible = False
 
        Range("B1").Select
            ActiveSheet.Protect
 
                ActiveWorkbook.Save
 
End Sub

et ces "innerText" ?

Code:

1
2
3
4
            If HtmlTag.Item(I).innerText = "Objectif de cours ?rois mois" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText
              If HtmlTag.Item(I + 2).innerText = "Potentiel" Then
                Valeur2 = HtmlTag.Item(I + 3).innerText

Les valeurs que tu as trouvées sont-elles :134,10 % pour le potentiel et 24 € pour l'objectif ?

Mon matériel serait-il en cause ?

Je suis déçu et vraiment désolé de t'avoir fait perdre tout ce temps.

Cordialement.
Nonno 94.