Discussion :

[Nonno 94]

Bonjour le forum,

je viens solliciter votre aide pour résoudre le problème suivant :

dans le fichier joint, la macro "Lire_Objectifs_Potentiels" me permet de copier les Objectifs et Potentiels de Valeurs dans les pages Internet "Consensus" de ces Valeurs (voir les feuilles "AB Science et ABC Arbitrage).

Je souhaite utiliser la macro "Lire_Cours_Potentiels" pour copier les Cours et Potentiels de ces mêmes Valeurs dans leurs pages Internet "Synthèse" identiques à la page "AB Science (Synthèse)" copiée dans la feuille du même nom.
Malheureusement, je ne parviens pas à modifier le code de cette macro pour copier les Potentiels et ne copie que le Cours (ce que je souhaite) et seulement le nom "Potentiel" et non sa valeur qui se trouve dans la cellule voisine sur la même ligne !
Pourriez-vous me dire ce qui "cloche" dans le code et quelle modification lui apporter ?

Est-il par ailleurs possible de copier en même temps dans ces feuilles "Synthèse" le Cours, l'Objectif et la Valeur ?

Je vous remercie par avance pour vos réponses et vous souhaite une bonne fin de journée.

Cordialement.
Nonno 94.

[Nonno 94]

Bonjour le forum,

je viens solliciter votre aide pour résoudre le problème suivant :

dans le fichier joint, le Code de la macro "Lire_Objectifs_Potentiels" me permet de sélectionner les données "Objectif" et "Potentiel" de Valeurs dans leur page Internet "Consensus" (voir les feuilles "AB Science et ABC Arbitrage) puis de les copier dans la feuille "Objectifs et Potentiels" du fichier.

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_Objectifs_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("Objectifs 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 = "Potentiel" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText         'Valeur 1 = Potentiel
              If HtmlTag.Item(I).innerText = "Potentiel" Then
                Valeur2 = HtmlTag.Item(I - 1).innerText         'Valeur 2 = Objectif
              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

Afin de sélectionner les données "Cours" et "Potentiel" de ces valeurs dans leur page Internet "Synthèse " puis de les copier dans le feuille "Cours et Objectifs" du fichier, j'ai modifié le Code de la macro "Lire_Objectifs_Potentiels" et créé la macro "Lire_Cours_Potentiels".

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 + 23).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

Malheureusement, cette modification ne fonctionne pas et je ne copie que le Cours (ce que je souhaite) et seulement le nom "Potentiel" et pas sa valeur qui se trouve dans la cellule voisine sur la même ligne !
Pourriez-vous me dire ce qui "cloche" dans le code et quelle modification lui apporter ?

Est-il par ailleurs possible de sélectionner en même temps dans ces pages Internet "Synthèse" puis de copier dans la feuille "Cours et Potentiels" du fichier le Cours, l'Objectif et la Valeur ?

Je vous remercie par avance pour vos réponses et vous souhaite une bonne journée.

Cordialement.
Nonno 94.