Bonjour le Forum,

ne parvenant pas à modifier un code qui fonctionne pour copier certaines données dans des pages Internet mais pas pour en copier d'autres, je viens demander votre aide pour me dire quelle modification lui apporter pour qu'il accepte de copier ces données.

L'adresse de la page Internet est la suivante :

Cours AB SCIENCE | AB | Cotation Bourse Paris - Les Echos Bourse

Ce code fonctionne pour copier le Cours et le + HAUT :

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
Sub Lire_Cours_Potentiels()
 
    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("Cours et Potentiels").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         'Valeur1 = HtmlTag.Item(I + 1).innerText
 
              If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur2 = HtmlTag.Item(I + 7).innerText       'Valeur2 = HtmlTag.Item(I - 1).innerText '
              End If
                Exit For
            End If
        Next I
        Cel.Offset(, 3) = Valeur1
        Cel.Offset(, 2) = 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
Modifié comme ci-dessous pour lire le Cours et l'Objectif,

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
            If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText         'Valeur1 = HtmlTag.Item(I + 1).innerText
 
              If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur2 = HtmlTag.Item(I + 22).innerText       'Valeur2 = HtmlTag.Item(I - 1).innerText '
              End If
                Exit For
            End If
Il copie bien le Cours mais pas l'Objectif dont il ne copie que le Nom et pas la Valeur !!

J'avoue ne pas comprendre la raison de ce "caprice" et vous demande donc de m'aider à résoudre ce problème.
Est-il par ailleurs possible de copier en même temps dans cette page le Cours, l'Objectif et le Potentiel ?


En vous remerciant pour votre aide et en vous souhaitant une bonne journée.

Cordialement.
Nonno 94.