Extraction d'un tableau web avec des erreurs de format

Version imprimable

Bonjour à tous,

J'ai parcouru quelques forums à la recherche d'une solution mais je n'arrive pas à en trouver.
Je vais brièvement expliquer mon problème:
Je cherche à extraire un tableau d'une page web. Jusque là tout va bien mais je rencontre 2 problèmes:
- les chiffres sont censés avoir des virgules et ils sont reportés sans virgules dans mon tableau
- j'ai des valeurs qui apparaissent avec un saut de ligne (ceux qui sont entre les balises <td class="high-rouge ou vert">).
Comment je pourrais faire pour avoir tous les nombres du même format pour que je puisse faire un graphique.
Voici ma macro en question:
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 Sub Importer_tableau() Dim IE As InternetExplorer Dim maPageHtml As HTMLDocument Dim Htable As IHTMLElementCollection Dim maTable As IHTMLTable Dim j As Integer, i As Integer Set IE = CreateObject("InternetExplorer.Application") IE.Visible = False Select Case MsgBox("Bonjour, vous allez être renvoyé vers une liste de cours, veuillez rentrer l'URL du cours qui vous intéresse dans la fenêtre suivante (cours puis historique)", vbOKCancel, "Niveaux de Fibonacci") Case vbOK Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True IE.navigate "http://investir.lesechos.fr/actions/cotations/cours-az.html" URL = Application.InputBox("Veuillez copier l'URL ici", "Niveaux de Fibonacci", "") Case vbCancel Exit Sub End Select IE.navigate URL Do Until IE.readyState = READYSTATE_COMPLETE DoEvents Loop Set maPageHtml = IE.document Set Htable = maPageHtml.getElementsByTagName("table") 'objet type table Set maTable = Htable(0) 'premier tableau dans la page Web For i = 1 To maTable.Rows.Length 'boucle sur toutes les lignes du tableau For j = 1 To maTable.Rows(i - 1).Cells.Length 'boucle sur les cellules dans chaque ligne Cells(i, j) = maTable.Rows(i - 1).Cells(j - 1).innerText Next j Next i End Sub
Voici en lien un exemple de tableau http://investir.lesechos.fr/cours/hi...0404,isin.html

Merci d'avance pour vos réponses

25/05/2016, 00h12
Marc-L

'soir !

Je viens de tester dans un nouveau classeur : aucun des deux soucis exposés, affichage correct …

_________________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …
25/05/2016, 10h11
Pandazz

Bonjour,

Je viens d'essayer dans un nouveau classeur et j'ai toujours le même soucis.
Merci pour la réponse néanmoins
25/05/2016, 10h25
Kiouane

Je confirme Marc-L. Je viens de tester aussi, tout est parfait.
25/05/2016, 10h45
Pandazz

Je ne comprends pas d'où ça peut venir alors. De la version Excel ? De la version d'IE ?
25/05/2016, 10h48
Kiouane

Je précise que moi j'ai testé juste le copier coller pour voir déjà si ça remet les données sous le même format.

Perso je ferais plutôt comme ça :

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
Sub Importer_tableau()
 
Dim IE As Object
Dim Table As Object
Dim j As Integer, i As Integer
 
Select Case MsgBox("Bonjour, vous allez être renvoyé vers une liste de cours, veuillez rentrer l'URL du cours qui vous intéresse dans la fenêtre suivante (cours puis historique)", vbOKCancel, "Niveaux de Fibonacci")
Case vbOK
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://investir.lesechos.fr/actions/cotations/cours-az.html"
URL = Application.InputBox("Veuillez copier l'URL ici", "Niveaux de Fibonacci", "")
Case vbCancel
Exit Sub
End Select
 
IE.navigate URL
    Do Until IE.readyState = 4
    DoEvents
Loop
 
Set Table = IE.document.all("tablehisto")
With CreateObject("htmlfile")
    If .parentWindow.clipboardData.setData("Text", Table.outerHTML) Then
        With Sheets(1)
            .Activate
            .UsedRange.Clear
            .Cells(1, 1).Select
            .Paste
        End With
    End If
End With
 
End Sub

En plus tu utilise CreateObject alors tu n'as pas besoin de typer tes variables !

Et pour quelque chose de 100x plus rapide en chargement :

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
Sub tab2()
    Dim pXmlHttp As Object
    Dim strPostData As String
 
    Set pXmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
 
    pXmlHttp.Open "GET", "http://investir.lesechos.fr/cours/historique-action-accor,xpar,ac,fr0000120404,isin.html", False
    pXmlHttp.send
 
 
    Dim HTMLdoc As Object
    Set HTMLdoc = CreateObject("HTMLFile")
    HTMLdoc.body.innerHTML = pXmlHttp.ResponseText
 
    With CreateObject("htmlfile")
    If .parentWindow.clipboardData.setData("Text", HTMLdoc.all("tablehisto").outerHTML) Then
        With Sheets(1)
            .Activate
            .UsedRange.Clear
            .Cells(1, 1).Select
            .Paste
        End With
    End If
End With
End Sub

Si tu veux lister toi même toutes les actions :

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
Sub list()
    Dim pXmlHttp As Object
    Dim HTMLdoc As Object
 
    Set HTMLdoc = CreateObject("HTMLFile")
 
    Set pXmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
 
    Dim page As Integer
    Dim row As Object
    Dim rgn As Range
    Set rgn = [A1]
 
    Do
        page = page + 1
        pXmlHttp.Open "GET", "http://investir.lesechos.fr/actions/cotations/cours-az.html/page" & page, False
        pXmlHttp.send
 
        HTMLdoc.body.innerHTML = pXmlHttp.ResponseText
        For Each row In HTMLdoc.all("tablecotation").tbodies(0).Rows
            With ActiveSheet
                .Hyperlinks.Add Anchor:=rgn, _
                Address:="http://investir.lesechos.fr/cours/historique-" & Split(row.Cells(0).Children(0).pathname, "/")(1), _
                TextToDisplay:=row.Cells(0).Children(0).Children(0).innerText
            End With
 
            Set rgn = rgn.Offset(1)
        Next
    Loop While HTMLdoc.all("tablecotation").tbodies(0).Rows.Length > 0
End Sub

Tu pourrais ensuite mettre ça dans un UserForm l’utilisateur choisi directement l'action et tu va chercher ensuite avec le code précédent ;)

Citation:

Envoyé par cerede2000

Perso je ferais plutôt comme ça :

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
Sub Importer_tableau()
 
Dim IE As Object
Dim Table As Object
Dim j As Integer, i As Integer
 
Select Case MsgBox("Bonjour, vous allez être renvoyé vers une liste de cours, veuillez rentrer l'URL du cours qui vous intéresse dans la fenêtre suivante (cours puis historique)", vbOKCancel, "Niveaux de Fibonacci")
Case vbOK
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://investir.lesechos.fr/actions/cotations/cours-az.html"
URL = Application.InputBox("Veuillez copier l'URL ici", "Niveaux de Fibonacci", "")
Case vbCancel
Exit Sub
End Select
 
IE.navigate URL
    Do Until IE.readyState = 4
    DoEvents
Loop
 
Set Table = IE.document.all("tablehisto")
With CreateObject("htmlfile")
    If .parentWindow.clipboardData.setData("Text", Table.outerHTML) Then
        With Sheets(1)
            .Activate
            .UsedRange.Clear
            .Cells(1, 1).Select
            .Paste
        End With
    End If
End With
 
End Sub

En plus tu utilise CreateObject alors tu n'as pas besoin de typer tes variables !

Merci beaucoup ! C'est nickel, exactement ce que je voulais

Citation:

Envoyé par cerede2000

Et pour quelque chose de 100x plus rapide en chargement :

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
Sub tab2()
    Dim pXmlHttp As Object
    Dim strPostData As String
 
    Set pXmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
 
    pXmlHttp.Open "GET", "http://investir.lesechos.fr/cours/historique-action-accor,xpar,ac,fr0000120404,isin.html", False
    pXmlHttp.send
 
 
    Dim HTMLdoc As Object
    Set HTMLdoc = CreateObject("HTMLFile")
    HTMLdoc.body.innerHTML = pXmlHttp.ResponseText
 
    With CreateObject("htmlfile")
    If .parentWindow.clipboardData.setData("Text", HTMLdoc.all("tablehisto").outerHTML) Then
        With Sheets(1)
            .Activate
            .UsedRange.Clear
            .Cells(1, 1).Select
            .Paste
        End With
    End If
End With
End Sub

Par contre je ne comprends ce code. Comment faites vous pour avoir que le tableau ?
Comment je peux faire pour l'adapter à mon code (avec l'InputBox) ?

25/05/2016, 12h11
cerede2000

Regarde mon code qui liste les actions avec leurs liens historique ;)
Tu prends ça, tu fait une petite fenêtre, l'utilisateur seletionne une action directement dans la fenêtre et tu va chercher le tableau correspondant.

Pour récupérer le tableau direct je passe pas le presse papier et la fonctionnalité Excel qui permet de coller du contenu HTML directement ;)
25/05/2016, 12h36
Pandazz

J'en reste bouche bé, je n'avais même pas penser à faire ça comme ça et honnêtement j'aurais jamais trouvé comment le coder.
Merci beaucoup, vraiment !