Import fichier TXT

Bonjour,

Je souhaite importer et mettre en forme un fichier TXT.

J'ai une macro faite avec l'enregistreur qui fonctionne mais le problème c'est qu'elle ne me laisse pas le choix du fichier. Il faut donc que je l’enregistre tjs au même format, tjs avec le même nom et tjs au même endroit. en l'occurrence: C:\Users\vlegueu\Desktop\inventaire.txt

Comme ce fichier a pour but d’être diffusé à toute une équipe, il faut que chacun puisse faire comme il veut.

Voici ce que j'ai:

Sub ImportInventaire()
'
' ImportInventaire Macro
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\vlegueu\Desktop\inventaire.txt", Destination:=Range("$D$2"))
        .Name = "inventaire_1"
        .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 = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(17, 38, 5, 13)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        Columns("D:D").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("G:G").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("D2:D6").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    End With
End Sub

J'ai tenté d'intégrer cette macro à la mienne mais ça ne fonctionne qu'à moitié car même si la finalité est remplie, la mise en page des données ne se fait plus automatiquement:

Sub ImportTextFile()

       Dim DestBook As Workbook, SourceBook As Workbook
       Dim DestCell As Range
       Dim RetVal As Boolean

       ' Turn off screen updating.
       Application.ScreenUpdating = False

       ' Set object variables for the active book and active cell.
       Set DestBook = ActiveWorkbook
       Set DestCell = ActiveCell

       ' Show the Open dialog box.
       RetVal = Application.Dialogs(xlDialogOpen).Show ("*.txt")

       ' If Retval is false (Open dialog canceled), exit the procedure.
       If RetVal = False Then Exit Sub

       ' Set an object variable for the workbook containing the text file.
       Set SourceBook = ActiveWorkbook

       ' Copy the contents of the entire sheet containing the text file.
       Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Copy

       ' Activate the destination workbook and paste special the values
       ' from the text file.
       DestBook.Activate
       DestCell.PasteSpecial Paste:=xlValues

       ' Close the book containing the text file.
       SourceBook.Close False

   End Sub

Si quelqu'un pouvait m'orienter un peu (voir beaucoup...) ça ne serait pas de refus.

En vous remerciant par avance.

Vincent

Bonjour,

Bon ben je n'ai pas eu d'aide par le forum mais j'ai finalement trouvé après plein de mélanges d'exemples.

Pour ceux que ça pourrait intéresser, voici mon code final:

Sub import_donnees()
Dim fich_txt As String
Dim fich_source As String

' Purge Inventaire
Sheets("Stock FE").Select
    Range("A1:E1").Select
    Selection.Cut
    Range("L1").Select
    ActiveSheet.Paste
    ActiveSheet.Range("$A$1:$G$500").AutoFilter Field:=7
    Columns("A:E").Select
    Selection.ClearContents
    Range("L1:P1").Select
    Selection.Cut
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    ActiveSheet.Paste

fich_source = ActiveWorkbook.Name

'demande a l'utilisateur de choisir un fichier
fich_txt = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")

'ouverture du fichier txt
Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True

' MiseEnForme
    Rows("1:8").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(17, 1), Array(51, 1), Array(58, 1), Array(73, 1)) _
        , TrailingMinusNumbers:=True
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 27

'Copie des lignes
 ActiveWindow.SmallScroll Down:=-21
    Range("A1:E1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

'collage spéciale des valeurs
Workbooks(fich_source).Sheets(2).[A2].PasteSpecial xlValues

'Mise en forme
Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

'fermeture du fichier
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
'
End Sub
Rechercher des sujets similaires à "import fichier txt"