Lire un tableau dans une page Internet

**Nonno 94** · 13/09/2012, 10h19

Bonjour le Forum,

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.

**Daniel.C** · 13/09/2012, 15h07

Bonjour,

Peut-être comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Nonno 94** · 13/09/2012, 16h38

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.

**Nonno 94** · 13/09/2012, 17h03

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.

**Nonno 94** · 13/09/2012, 17h59

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

et non :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Cordialement.
Nonno 94.

**Daniel.C** · 13/09/2012, 18h52

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Nonno 94** · 13/09/2012, 19h39

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.

**Daniel.C** · 14/09/2012, 10h29

Impressionnant !!!!

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Nonno 94** · 14/09/2012, 12h18

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Daniel.C** · 14/09/2012, 15h06

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 ?

**Nonno 94** · 14/09/2012, 15h38

J'ai joint un fichier au dernier message !

Je le joins à nouveau à cette réponse.

**Daniel.C** · 14/09/2012, 16h06

Ca ne viendrait pas du "?" dans "Objectif de cours ?rois mois" ?

**Nonno 94** · 14/09/2012, 16h27

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**Daniel.C** · 14/09/2012, 16h39

Je trouve "Potentiel" en lançant la macro "Lire_Valeurs_Myta_Echos_2". Valeur de I : 289.

**Nonno 94** · 14/09/2012, 17h11

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.

**Daniel.C** · 14/09/2012, 17h43

Que veux-tu que je te dise de plus ? Je trouve bien "Objectif de cours à trois mois" et "Potentiel" pour AB Science.

**Qwazerty** · 14/09/2012, 17h53

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

**Nonno 94** · 14/09/2012, 18h03

Avec ce code ? :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

Lire un tableau dans une page Internet

Macros et VBA Excel

Discussions similaires

Partager

Partager