[XL-2007] Importer ou transformer automatiquement un fichier .txt en excel, est -il possible ?

[Debutant10]

Bonjour,

Comment Importer ou transformer un fichier .txt en excel automatiquement en VBA, est -il possible ? pour gagner du tps... car un peu galère manuellement.

Mon pb : je fais des extractions tout les jours d 'une appli intranet et j'ai besoin d 'automatiser pour transformer un fichier .txt en excel automatiquement.

comment faire ? en vba pour que les données du fichier texte soient bien poisitionnées dans un format excel.

Merci pour votre aide

[Daniel.C]

Bonjour,

Active l'enregistreur de macros et fais la manip manuellement (et arrête l'enregistreur).

[Debutant10]

J'ai plusieurs fois la manip à faire par jou je voudrais une fois les données en .txt exporter les sauvegarder dans un fichier tampon puis avec une macro dédiée transformer le fichier .txt en fichier excel.

Merci mais pas très pratique (est-ce du bricolage ? ) , y-a-t-il une possibilité par vba simple ?

[kiki29]

Salut,ceci n'est qu'un exemple perfectible sans doute et à adapter surement pour LectureTXT

Dans un modulestandard baptisé par exemple mImport
Affecter un bouton à SelFichier

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
 
Option Explicit
 
Public sNomFichierImport As String
 
Sub SelFichier()
Dim sChemin As String
    sChemin = ThisWorkbook.Path
 
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le fichier TXT"
        .AllowMultiSelect = False
        .ButtonName = "Sélection Fichier"
 
        .Filters.Clear
        .Filters.Add "Texte", "*.txt"
 
        .Show
        If .SelectedItems.Count > 0 Then
            DoEvents
            Application.ScreenUpdating = False
            ShDatas.Cells.Clear
 
            sNomFichierImport = .SelectedItems(1)
 
            LectureTXT .SelectedItems(1)
 
            With ShDatas
                .Activate
                .Range("A1").Select
            End With
            Application.ScreenUpdating = True
        End If
    End With
End Sub
 
Private Sub LectureTXT(sFichier As String)
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim sChaine As String, i As Long
Dim Separateur As String, Ar() As String
 
    NumFichier = FreeFile
    Separateur = vbTab
 
    iRow = 1
    Open sFichier For Input As NumFichier
        Do While Not EOF(NumFichier)
            iCol = 1
            Line Input #NumFichier, sChaine
            Ar = Split(sChaine, Separateur)
            For i = LBound(Ar) To UBound(Ar)
                If IsDate(Ar(i)) Then
                    ShDatas.Cells(iRow, iCol) = CDate(Ar(i))
                Else
                    ShDatas.Cells(iRow, iCol) = Ar(i)
                End If
                iCol = iCol + 1
            Next i
            iRow = iRow + 1
        Loop
    Close NumFichier
End Sub

Dans un autre module standard baptisé par exemple mSauvegarde
Affecter un bouton à Sauvegarde
ShDatas est le CodeName de la feuille recevant les données du fichier texte
voir http://www.developpez.net/forums/d92...cel/vba-bases/

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
 
Option Explicit
 
Sub Sauvegarde()
Dim WkbDep As Workbook
Dim WkbSave As Workbook
Dim sNomXLS As String
Dim Rep As Long
 
    If Len(sNomFichierImport) = 0 Then Exit Sub
    sNomXLS = Left$(sNomFichierImport, InStrRev(sNomFichierImport, ".") - 1) & ".xls"
 
    If ExistenceFichier(sNomXLS) Then
        Rep = MsgBox("Ce fichier existe déjà" & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", vbCritical + vbYesNo, "Ecraser le fichier")
        Select Case Rep
            Case 6
                Application.ScreenUpdating = False
 
                Set WkbDep = ThisWorkbook
                WkbDep.Sheets(ShDatas.Name).UsedRange.Copy
 
                Set WkbSave = Workbooks.Add
                With ActiveSheet
                    .Paste
                    .Range("A1").Select
                End With
 
                With Application
                    .CutCopyMode = False
                    .DisplayAlerts = False
                End With
 
                WkbSave.SaveAs Filename:=sNomXLS, FileFormat:=xlNormal
                ActiveWindow.Close
 
                With Application
                    .DisplayAlerts = True
                    .ScreenUpdating = True
                End With
 
                Set WkbDep = Nothing
                Set WkbSave = Nothing
        End Select
    Else
        Application.ScreenUpdating = False
 
        Set WkbDep = ThisWorkbook
        WkbDep.Sheets(ShDatas.Name).UsedRange.Copy
 
        Set WkbSave = Workbooks.Add
        With ActiveSheet
            .Paste
            .Range("A1").Select
        End With
 
        Application.CutCopyMode = False
 
        WkbSave.SaveAs Filename:=sNomXLS, FileFormat:=xlNormal
        ActiveWindow.Close
        Application.ScreenUpdating = True
 
        Set WkbDep = Nothing
        Set WkbSave = Nothing
    End If
End Sub
 
Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> ""
End Function

L'ensemble est concaténable très facilement dans un seul module si l'on ne veut pas 2 étapes Import et Sauvegarde

[Debutant10]

Merci pour votre mais j'ai placé les deux codes mais n'arrive pas à le faire fonctionner, pouvez vous jeter un oeil ?

L'idée est simple transférer un fichier texte dans excel.

est ce que le placement du code est bon ?

[helas]

Bonjour,
En enregistrant une macro, le code donne à peu près ceci
Modifier les chemins et noms de dossier

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
 
 With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;E:\fichier à transformer en excel .txt", Destination:=Range("$A$1"))
        .Name = "fichier à transformer en excel "
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
 
    ActiveWorkbook.SaveAs Filename:="E:\Classeur2.xlsx", FileFormat:= _
        xlWorkbookNormal, CreateBackup:=False

[kiki29]

Salut, en reprenant le code donné plus haut et avec le minimum de modifications

[Debutant10]

Tout d 'abord merci pour votre aide j y vois un plus clair !!! impec!!! le seul petit pb j 'ai unE ERREUR au niv de l import
la macro bloque et il importe les données sur la ligne 1 uniquement à l horizontal de A 1 à IU 1

Code :

ShDatas.Cells(iRow, iCol) = Ar(i)

comment faire pour que cela face un tableau et non pas une ligne merci

[kiki29]

re, avec le fichier de test que tu as fourni plus haut cela fonctionne sans problèmes