Automatisation VBA de la conversion tableau internet en tableau excel exploitable

Version imprimable

01/11/2015, 20h52
baryum

1 pièce(s) jointe(s)

Automatisation VBA de la conversion tableau internet en tableau excel exploitable

Bonsoir, je viens vers vous car j'ai besoin que l'on me propose des pistes étant donné que j'ai fais le tour ;)

J'ai créé un fichier excel qui permet d'extraire d'internet un tableau (CAC40) qui se mettra à jour toutes les minutes voir moins. J'ai annulé cette actualisation pour le moment pour faciliter le travail sur le code sans être dérangé par des mises à jours. Le programme correspond au bouton 1 du fichier et il fonctionne.

J'ai ensuite commencer à mettre des mises en formes conditionnelles sur certaines cellules (J2 K2 L2) en relation avec le tableau que j'ai importé sur internet. Cependant, je me suis rendu compte que on était en présence de . au lieu de virgule dans le tableau. J'ai donc manuellement changé les points en virgules avec l'option d'excel "Remplacer". Cela fonctionne :)

Etape 1 : Je clique sur le bouton 1 (La case L2 est verte, ce qui n'est pas correct d'après mes conditions, c'est la case K2 qui devrait être jaune).
Etape 2 : Je sélectionne la plage "B9:H48" puis me dirige dans accueil , Rechercher et sélectionner, Remplacer . par , et ok ( la case K2 devient jaune et la case L2 devient sans couleur).

Mais mon but est d'automatiser cette tache pour l'actualisation toutes les minutes. J'ai donc fais un enregistrement macro que voilà :

Code:

Range("B9:H48").Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Je l'ai introduit à la suite de mon programme VBA (macro1 après extration du tableau), cependant je n’obtiens pas le même résultat ??? J'ai mis un ' devant pour le moment et reproduit le code dans la macro 2 associé au bouton 2 du fichier. Au final cliqué sur le bouton 1 puis sur le bouton 2. C'est la macro du bouton 2 qui ne fonctionne pas.

Voilà les anomalies :

- il me met parfois des espaces au lieu de la virgule
- Même si il change le point en virgule (cellule G35) la forme conditionnel reste verte en L2 ET La case K2 ne devient pas jaune.
- Rentrer manuellement la valeur 85,73 dans la case G35 et les choses cela fonctionne

C'est perturbant :)

Je met le fichier excel en pièce jointe pour une meilleur compréhension.

Mon but : Automatiser la conversion que la plage G9:H48 et sans erreur dans le tableau.

Je vous remercie d'avance, de mon côté je continu à chercher mais je serais ravi d'avoir un peu d'aide sur cette question. Si il y a besoin de plus de précisions, n'hésitez à me le dire.
01/11/2015, 21h30
mercatog

Basiquement

Mets

Code:

Range("B9:H48").Replace What:=".", Replacement:="."

Et reviens pour l'explication

que dire à part merci, c'est basique en effet.

C'est deux formules on le même effet et fonctionne, donc je prends la deuxième plus simple
Code:

1 2 3 Range("B9:H48").Replace What:=".", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Range("B9:H48").Replace What:=".", Replacement:="."
Explication par déduction :

ta formule qui fonctionne :

Code:

Range("B9:H48").Replace What:=".", Replacement:="."

ma formule qui ne fonctionne pas :

Code:

Range("B9:H48").Replace What:=".", Replacement:=","

La même formule, à la différence que de mon côté, je lui demande de remplacer le "." par ","

Je pense que c'est une différence d'interprétation d'excel et de VBA sur le symbole ","

Dans ton code,

Code:

Range("B9:H48").Replace What:=".", Replacement:="."

, tu demandes en VBA de remplacer un . par un . dans la plage. Sur le tableau excel, cela se traduit par un remplacement des points par des virgules.

Je ne sais pas si c'est la bonne explication, mais merci de me confirmer pour partir du forum un peu moins bête ;)

Merci encore pour ton aide

Oui tu as vu juste

Citation:

tu demandes en VBA de remplacer un . par un . dans la plage. Sur le tableau excel, cela se traduit par un remplacement des points par ~~des virgules~~ le séparateur décimal

Pour plus de clarté, les séparateur décimal de vba est toujours le point.

Il faudra donc lire, remplacer les points par le séparateur décimal

PS.

Pour simplifier ton 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
Sub Macro1()
 
Application.ScreenUpdating = False
With Feuil2
    .Range("A8:H48").Clear
    With .QueryTables.Add(Connection:="URL;https://www.abcbourse.com/marches/indice_cac40.aspx", Destination:=.Range("A8"))
        .Name = "indice_cac40"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = """tabQuotes"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        .Delete
    End With
    .Parent.Connections(1).Delete
    With .Range("A8:H48")
        .Replace ".", "."
        .Borders.LineStyle = xlContinuous
    End With
End With
End Sub

01/11/2015, 22h47
Invité

Bonsoir,
Ceci dit, Range("B9:H48").value=Range("B9:H48").value .
C'est la même chose!

Excel tient compte des paramètres régionaux vba non, Excel (. = .) vba (. = , ) séparateur décimale!
01/11/2015, 23h25
baryum

merci pour la simplification ;)
02/11/2015, 00h05
kiki29

Salut, se rappeler qu'Office est un logiciel conçu aux USA donc sous VBA séparateur décimal, de liste, date etc le sont également.

1 pièce(s) jointe(s)

bonjour, je reviens vers vous et dans cette discussion, pour vous faire part du code final fonctionnel que j'utilise actuellement :

dans thisWorkbook pour lancer la macro TableauCAC40

Code:

1
2
3
4
5
6
7
8
Option Explicit
 
Private Sub Workbook_Open()
 
 
 Call TableauCAC40
 
End Sub

Dans un module

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
64
65
Option Explicit
 
Sub TableauCAC40()
 
' Définit l'intervalle avec l'heure actuelle + 15 secondes
 
Dim Dans30Secondes As Date
Dans30Secondes = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 15)
 
' Répétition de la macro dans 15 secondes
 
Application.OnTime Dans30Secondes, "TableauCAC40"
 
' Supprime la connexion
 
Feuil2.Parent.Connections(1).Delete
 
' Cache l'éxecution du programme
 
Application.ScreenUpdating = False
 
' Supprime les anciennes valeurs et Extration des données du CAC40
 
With Feuil2
    .Range("B9:I49").Clear
    With .QueryTables.Add(Connection:="URL;http://www.abcbourse.com/marches/indice_cac40.aspx", Destination:=.Range("B9"))
        .Name = "indice_cac40"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = """tabQuotes"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        '.Delete
    End With
 
' Remplacement des . par des . et Bordure tableau
 
    With .Range("B9:I49")
        .Replace ".", "."
        .Borders.LineStyle = xlContinuous
    End With
End With
 
' Redimenssionne les cellules
Columns("C:I").ColumnWidth = 12
 
'Annule le cache de l'execution
Application.ScreenUpdating = True
 
End Sub

1 pièce(s) jointe(s)

J'utilise le site ABC bourse par défaut, http://www.abcbourse.com/marches/indice_cac40.aspx, mais les actualisations ne sont pas aussi fréquentes que sur boursorama : http://www.boursorama.com/bourse/act...?MARCHE=1rPCAC

Mais excel n'arrive pas via onglet données web à identifier le tableau de boursorama et l'extraire... comme il a pu le faire avec abc bourse.
Dans le code source de la page boursorama, ligne 531 à 1043 on retrouve le tableau mais je n'ai pas trouvé la solution pour utiliser le même code que abc bourse :( donné au dessus.

J'ai contourné le problème avec un autre codage que je trouve un peu plus long. Voici le code :

Dans thisworkbook

Code:

1
2
3
4
5
Option Explicit
 
Private Sub Workbook_Open()
Call test
End Sub

Dans un module :

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
Sub test()
 
' Définit l'intervalle avec l'heure actuelle + 30 secondes
 
Dim Dans30Secondes As Date
Dans30Secondes = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 30)
 
' Répétition de la macro dans 30 secondes
 
Application.OnTime Dans30Secondes, "test"
 
 
Dim IE As InternetExplorer
Dim maPageHtml As HTMLDocument
Dim Htable As IHTMLElementCollection
Dim maTable As IHTMLTable
Dim j As Integer, i As Integer
Dim Cible As String
 
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
 
IE.navigate " http://www.boursorama.com/bourse/actions/cours_az.phtml?MARCHE=1rPCAC"
 
 
    Do Until IE.readyState = READYSTATE_COMPLETE
    DoEvents
Loop
 
Set maPageHtml = IE.document
'objet type table
Set Htable = maPageHtml.getElementsByTagName("table")
'deuxième tableau dans la page Web
Set maTable = Htable(0)
 
' cache l'execution du programmme sur excel
 Application.ScreenUpdating = False
 
'boucle sur toutes les lignes du tableau
For i = 1 To maTable.Rows.Length
    'boucle sur les cellules dans chaque ligne
    For j = 1 To maTable.Rows(i - 1).Cells.Length
 
        Cible = maTable.Rows(i - 1).Cells(j - 1).innerHTML
 
        If Left(Cible, 8) = "<A href=" Then
            Feuil1.Hyperlinks.Add Cells(i, j), Mid(Cible, 10, InStr(10, Cible, ">") - 11)
        Else
            Cells(i, j) = maTable.Rows(i - 1).Cells(j - 1).innerText
        End If
    Next j
Next i
 
' quitter la page internet
IE.Quit
 
'Suppression colonne inutile
Feuil1.Range("A:A,C:C,I:I,J:J").Delete
 
 
' Redimenssionne les cellules
Columns("A:A").ColumnWidth = 30
Columns("B:F").ColumnWidth = 15
Columns("B:F").HorizontalAlignment = xlCenter
 
' Suppression du (c)
 
Dim montexte As String
Dim resultat As String
Dim k As Integer
 
    If Right(Feuil1.Cells(2, 2), 3) = "(c)" Then
 
        For k = 2 To 41
        montexte = Feuil1.Cells(k, 2)
        resultat = Left(montexte, Len(montexte) - 4)
        Feuil1.Cells(k, 2) = resultat
        Next k
 
    End If
 
' Remplacement des . par des . et Bordure tableau
 
    With Feuil1.Range("A1:F41")
        .Replace ".", "."
        .Borders.LineStyle = xlContinuous
    End With
 
' rend visible le résultat sur excel
Application.ScreenUpdating = True
 
' efface le contenu des variables
Set IE = Nothing
Set maPageHtml = Nothing
Set Htable = Nothing
Set maTable = Nothing
 
End Sub

Je ne sais pas si mercatog est dans le coin ou si une autre personne souhaite se pencher sur ce problème. J'ai trouvé une solution, certe ci dessus pour contourner le problème mais celle ci est plus lente :(

Voilà ce que je cherche :
Idéalement : utiliser le méthode de codage de ABC bourse pour Boursorama
Sinon : Simplifier le code de ma solution de contournement pour rendre l'action plus rapide.

Voir une autre solution qui m'échappe ;)

merci d'avance, de mon côté je continue à chercher une solution plus rapide pour extraire le tableau boursorama CAC40