Bonjour,

J'ai un problème avec l'import des tableaux web. Voici le code en question, dont la partie en rouge importe les états financiers de tous les titres d'un fichier.

Les données qui en résultent sont séparées au milliers par des virgules et il n'y a jamais de cents.

Comme mon excel sépare les cents au niveau des virgules, lorsque le montant est de moins d'un million (2 virgules) il comprend 439 ,000 comme étant 439.

Je pourrais contourner ce problème en multipliant par 1000 tous les montants inférieurs à un million, mais j'aimerais tout de même mieux intégrer les bonnes commandes à ma requête.

J'ai fouillé internet sans succès, alors si la réponse à ma question existe déjà, sachez que j'ai cherché ardemment.

MERCI DE VOTRE SOUTIENT,


Phil

Voici la macro :

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
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
'Technical download function
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
 
 'Download CSV containing historical prices from Yahoo Finance
 'and open with Microsoft Excel
 'VBA code by Joshua Radcliffe, www.joshuaradcliffe.com
  
Sub MAJ_EF()
'
' MACRO MAJ_EF
'
Dim Repertoire As String, Fichier As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim i As Integer
Dim download
Dim stocklink As String
Dim savefile As String
Dim stock As String
    
    
        Application.Volatile
    Application.DisplayAlerts = False
    
    
'Définit la Première feuille du classeur contenant cette macro
'(pour recevoir les donnée extraites dans les autres classeurs).
Set Ws = ThisWorkbook.Worksheets(1)
 
'Définit le répertoire de recherche
Repertoire = "A:\Documents\Bourse\Données par titres\"
'Spécifie la recherche pour le fichiers .xlsx
Fichier = Dir(Repertoire & "*.xlsx")
 
'Boucle sur les fichiers du répertoire
Do While Fichier <> ""
    'Vérifie que le nom du classeur est différent du classeur
    'contenant cette macro (dans le cas ou il serait placé dans le même répertoire).
    If ThisWorkbook.Name <> Fichier Then
        'Ouvre chaque classeur
        Set Wb = Workbooks.Open(Repertoire & Fichier)
        i = i + 1
        
        Application.ScreenUpdating = False
          
    stock = Sheets("Cotes").Cells(1, 1).Value
    
    Sheets("ER Annuels").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://fr-ca.finance.yahoo.com/q/is?s=" & stock & "&annual", _
        Destination:=Range("$A$1"))
        .Name = "ER ANNUELS"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
      
    Application.Goto Range("A1"), True
        
       'Enregistre & Ferme
        ActiveWorkbook.Save
                     
        Application.ScreenUpdating = True
        
    End If
    
    Fichier = Dir
    
Loop

'   Réactive les alertes d'application
'
    Application.DisplayAlerts = Tru
    

End Sub