Ouverture fichier texte précis

**pacolapin** · 15/06/2019, 18h43

Bonjour, j'aimerai ouvrir un fichier texte précis sans avoir à passer par l'explorateur de recherche, et pouvoir définir le chemin dans le code et quand je clique sur le bouton ça l'importe directement, j'ai essayé plusieurs chose comme openfiletext mais en vain?

Auriez vous une idée ?

Merci d'avance.

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
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
Private Sub importerlive_Click()

    Dim fichier_choisi As Variant
    
    fichier_choisi = Application.GetOpenFilename("C:\Users\PC PACO\Desktop\BTS MASEN\Projet BTS\TRANSFERT\JK\20-05-2019.txt", FileFilter:=" txt file or  Excel Files ( *.txt;*.xlsx;*.xls;*.xlsm), ( *.txt;*.xlsx;*.xls;*.xlsm), All Files, *.*", FilterIndex:=1)
    If fichier_choisi = False Then Exit Sub
    If LCase(Mid(fichier_choisi, InStrRev(fichier_choisi, ".") + 1)) = "txt" Then
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier_choisi, Destination:=Sheets("import - export").Range("$A$1"))
            .FieldNames = True
            .PreserveFormatting = True
            .RefreshStyle = xlInsertDeleteCells
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileTabDelimiter = True
            .TextFileColumnDataTypes = Array(4, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            .Delete
        End With
        With ActiveSheet
            tablo = .UsedRange.Value
            .UsedRange.Clear
            .Range("A:A").NumberFormat = "DD/MM/YYYY"
            .Range("B:B").NumberFormat = "h:mm;@"
            .Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)).Value = tablo
        End With
    Else
     Workbooks.OpenText fichier_choisi, local:=True
        Set WB = ActiveWorkbook
        With ActiveSheet
            tablo = .UsedRange.Value
            .UsedRange.Clear
            .Range("B:B").NumberFormat = "h:mm;@"
            .Range("A:A").NumberFormat = "DD/MM/YYYY"
            .Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)).Value = tablo
            .UsedRange.Copy Destination:=ThisWorkbook.Sheets(1).Cells(1)    'on rapatrie sur le classeur 1
            Application.DisplayAlerts = False
            ActiveWorkbook.Close
        End With
    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

**clementmarcotte** · 15/06/2019, 22h52

Bonjour,

Si j'ai bien compris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

fichier_choisi = "C:\Users\PC PACO\Desktop\BTS MASEN\Projet BTS\TRANSFERT\JK\20-05-2019.txt"

devrait aller.

En n'oubliant pas que la programmation "en dur" diminue énormément la flexibilité de la macro. Mais bon si c'est une seule macro pour un seul fichier qui ne changera jamais.

Sinon, ajoute un textbox sur un UserForm, ou une InputBox.

Et si le Service de Dictature Informatique est d'accord, il y a ce petit utilitaire pour copier des chemins d'accès. Le programme d'installation ajoute des entrées de menus contextuels. Et les Services de Dictature Informatique sont allergiques à des choses qui sortent de l'uniformité institutionnelle obligatoire. Et c'est tellement facile de se tromper quand on entre des chemins d'accès à la mitaine.

**Pierre Fauconnier** · 16/06/2019, 07h47

Salut.

Au delà de la réponse de Clément, je me pose la question de l'utilité d'un tel code. Il me semblerait plus utile de planter le décor dans un modèle Excel ( fichier XLTM) et de lier les données tu txt via l'onglet Données du ruban qui permet des liaisons avec mises à jour, etc...

Au passage et pour compléter Clément sur le problème du hard coding, un fichier de travail sur le bureau, c'est loin d'être le top

Il me semblerait plus judicieux de le déposer dans un dossier, et de rendre son chemin et nom variables en stockant l'info dans une cellule, qui serait nommée, dans l'idéal. Ca donnerait un peu de souplesse à ton outil.

Ouverture fichier texte précis [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager