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 SubJ'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 SubSi 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