[XL-2016] Automatisation de l'importation

Automatisation de l'importation

Bonjour, j'essaye d'automatiser l'import d'un fichier txt vers excel pour faire des graphiques après.
Voici mon code si vous avez la solution je ne suis pas contre ? ;) Merci

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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Private Sub importerlive_Click()
 
Set wb = filename"C:\Users\PC PACO\Desktop\BTS MASEN\Projet BTS\TRANSFERT\JK"
sPath = wb.Path & Application.PathSeparator
res = FileLen(wb.Path & Application.PathSeparator & "20-05-2019.txt")
While res = 0
    res = FileLen(wb.Path & Application.PathSeparator & "20-05-2019.txt")
Wend
    t = Now + TimeValue("00:05:00")
    If Range("a2").Value = 0 Then
    Application.ScreenUpdating = False
 
    Sheets("données").Select
    Range("A1:XX7000").Select
    Selection.ClearContents
    Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & wb.Path & Application.PathSeparator & "données.txt", Destination:=Range("$A$7"))
    .Name = "données"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = True
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = True
    .TextFileColumnDataTypes = Array(1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=True
End With
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("recap").Select
Range("B30").Select
Application.ScreenUpdating = True
Application.OnTime t, "importer"
Else
    Application.OnTime t, "importer", schedule:=False
Exit Sub
End If
 
 
    Columns("AE:XX").Delete Shift:=xlToLeft
 
    Range("A1:XX500").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Columns(3).TextToColumns FieldInfo:=Array(1, 1)
        Columns(4).TextToColumns FieldInfo:=Array(1, 1)
        Columns(5).TextToColumns FieldInfo:=Array(1, 1)
        Columns(6).TextToColumns FieldInfo:=Array(1, 1)
        Columns(7).TextToColumns FieldInfo:=Array(1, 1)
        Columns(8).TextToColumns FieldInfo:=Array(1, 1)
        'I(9) direction vent
        Columns(10).TextToColumns FieldInfo:=Array(1, 1)
        Columns(11).TextToColumns FieldInfo:=Array(1, 1)
        'L(12) direction vent
        Columns(13).TextToColumns FieldInfo:=Array(1, 1)
        Columns(14).TextToColumns FieldInfo:=Array(1, 1)
        Columns(15).TextToColumns FieldInfo:=Array(1, 1)
        Columns(16).TextToColumns FieldInfo:=Array(1, 1)
        Columns(17).TextToColumns FieldInfo:=Array(1, 1)
        Columns(18).TextToColumns FieldInfo:=Array(1, 1)
        Columns(19).TextToColumns FieldInfo:=Array(1, 1)
        Columns(20).TextToColumns FieldInfo:=Array(1, 1)
        Columns(21).TextToColumns FieldInfo:=Array(1, 1)
        Columns(22).TextToColumns FieldInfo:=Array(1, 1)
        Columns(23).TextToColumns FieldInfo:=Array(1, 1)
        Columns(24).TextToColumns FieldInfo:=Array(1, 1)
        Columns(25).TextToColumns FieldInfo:=Array(1, 1)
        'Z(26) c'est quoi ?
        'AA(27) c'est quoi ?
        'AB(28) c'est quoi ?
        Columns(29).TextToColumns FieldInfo:=Array(1, 1)
        Columns(30).TextToColumns FieldInfo:=Array(1, 1)
 
        Sheets("Moyenne").Delete
        Sheets.Add
        ActiveSheet.Name = "Moyenne"
 
        Sheets("Graphiquetemperature").Delete
        Sheets.Add
        ActiveSheet.Name = "Graphiquetemperature"
 
        Sheets("Graphiquehumidite").Delete
        Sheets.Add
        ActiveSheet.Name = "Graphiquehumidite"
 
        Sheets("Graphiquevitessevent").Delete
        Sheets.Add
        ActiveSheet.Name = "Graphiquevitessevent"
 
        Sheets("Graphiquetransmissiondonnees").Delete
        Sheets.Add
        ActiveSheet.Name = "Graphiquetransmissiondonnees"
 
        Sheets("Graphiquepluie").Delete
        Sheets.Add
        ActiveSheet.Name = "Graphiquepluie"
 
        Sheets("Graphiqueatm").Delete
        Sheets.Add
        ActiveSheet.Name = "Graphiqueatm"
 
        Sheets("GraphiqueCombineTemperature").Delete
        Sheets.Add
        ActiveSheet.Name = "GraphiqueCombineTemperature"
 
        Sheets("GraphiqueCombineVent").Delete
        Sheets.Add
        ActiveSheet.Name = "GraphiqueCombineVent"
 
End Sub

Bonjour,

La ligne 3 est erronée et je ne vois pas quelle est votre intention.
Pourquoi ne pas simplement faire ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub importerlive_Click()
    data = "C:\Users\PC PACO\Desktop\BTS MASEN\Projet BTS\TRANSFERT\JK\20-05-2019.txt"
    t = Now + TimeValue("00:05:00")
    If Range("a2").Value = 0 Then
    Application.ScreenUpdating = False
    Sheets("données").Select
    Range("A1:XX7000").Select
    Selection.ClearContents
    Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & data , Destination:=Range("$A$7"))
    .Name = "données"
...

Cordialement

Perso, je trouve plus simple de passer par un OpenText plutôt que par une table de requête.
https://docs.microsoft.com/fr-FR/off...books.opentext

D'autant plus que l'enregistreur de macro, s'il est utilisé proprement, peut donner 90% du code pour cette méthode.