Ouvrir un fichier texte et le modifier avec une maccro

tmbangue

XLDnaute Nouveau
Bonjour, étant débutant dans les maccro Excel je requiert votre aide.

Je souhaite par le biais d'une maccro :
- Ouvrir un fichier texte (obligatoirement) avec un nom différent et un chemin différent.
- L'afficher dans ma feuille de calcul existante 'Fichier à importer' en A1.
- Remplacer les "." par des "," et convertir les données texte en décimales.

J'ai déjà bien cherché et testé pleins de choses (GetOpenFilename par exemple) malheureusement le nom du fichier me bloque toujours et c'est bien le problème.

Je vous remercie d'avance de votre réponse. :)
 

Modeste geedee

XLDnaute Barbatruc
Bonsour®
Bonjour, étant débutant dans les maccro Excel je requiert votre aide.

Je souhaite par le biais d'une maccro :
- Ouvrir un fichier texte (obligatoirement) avec un nom différent et un chemin différent.
- L'afficher dans ma feuille de calcul existante 'Fichier à importer' en A1.
- Remplacer les "." par des "," et convertir les données texte en décimales.

J'ai déjà bien cherché et testé pleins de choses (GetOpenFilename par exemple) malheureusement le nom du fichier me bloque toujours et c'est bien le problème.

Je vous remercie d'avance de votre réponse. :)
le plus simple est de passer par l'enregistreur de macro ( c'est la meilleure façon d'apprendre le code VBA)
en effectuant toutes les opérations citées ci-dessus

puis tu reviendra ici nous communiquer le code obtenu qui fonctionne,
on pourra alors l'épurer, le paramétrer
 

tmbangue

XLDnaute Nouveau
Bonjour,
Voilà donc le code qui sort de l'enregistreur. Comme vous pouvoir le voir le fichier porte le nom de "Enceinte 2-1" dans le chemin "AS-8\Réponses en fréquences\Export\02-05-2019"'

Mais, je souhaite pouvoir appliquer ce programme par exemple pour l'enceinte 4-1 (test de performances) dans le chemin Export\10-05-2019 ( la date des tests).

Merci pour votre rapide réponse en tout cas. :)


Sub Bouton_Take_and_replace()
'
' Bouton_Take_and_replace Macro
'

'
Range("A1").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Enceinte 2-1 (2)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""C:\Users\Theo\Documents\Stage\AS-8\Réponses en fréquences\Export\02-05-2019\Enceinte 2-1.txt""),null,{0, 16, 32},null,1252)," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Enceinte 2-1 (2)"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Enceinte 2-1 (2)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Enceinte_2_1__2"
.Refresh BackgroundQuery:=False
End With
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CommandBars("Queries and Connections").Visible = False
Range("Enceinte_2_1__2[[#All],[Column1]]").Select
Selection.TextToColumns Destination:=Range( _
"Enceinte_2_1__2[[#Headers],[Column1]]"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("Enceinte_2_1__2[[#All],[Column2]]").Select
Selection.TextToColumns Destination:=Range( _
"Enceinte_2_1__2[[#Headers],[Column2]]"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("Enceinte_2_1__2[[#All],[Column3]]").Select
Selection.TextToColumns Destination:=Range( _
"Enceinte_2_1__2[[#Headers],[Column3]]"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("Enceinte_2_1__2[[#Headers],[Column1]]").Select
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonsoir

Apparemment, tu as utilisé PowerQuery quand tu ouvert le fichier *.txt, non ?
Tu n'as pas essayé de l'ouvrir à l'ancienne?
(Comme je l'ai fait avec la macro ci-dessous)
VB:
Sub Import_TXT()
Dim strPath$
'Ci-dessous adapter les noms du chemin et du fichier Texte
strPath = "C:\Users\STAPLE\Documents\2019\"
TXT_Fic = "tests.txt"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strPath & TXT_Fic, Destination:=Range("$A$1"))
        .Name = "tests"
        .FieldNames = True
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileOtherDelimiter = ""
        .TextFileDecimalSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
 

tmbangue

XLDnaute Nouveau
Bonsoir

Apparemment, tu as utilisé PowerQuery quand tu ouvert le fichier *.txt, non ?
Tu n'as pas essayé de l'ouvrir à l'ancienne?
(Comme je l'ai fait avec la macro ci-dessous)
VB:
Sub Import_TXT()
Dim strPath$
'Ci-dessous adapter les noms du chemin et du fichier Texte
strPath = "C:\Users\STAPLE\Documents\2019\"
TXT_Fic = "tests.txt"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strPath & TXT_Fic, Destination:=Range("$A$1"))
        .Name = "tests"
        .FieldNames = True
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileOtherDelimiter = ""
        .TextFileDecimalSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Bonjour

Non car PowerQuery est-ce que Excel me propose de base et je n'ai pas cherché à aller plus loin. Après j'ai tenté d'essayer ton programme (en changeant les noms et chemins des fichiers) mais sans succès...
 

Staple1600

XLDnaute Barbatruc
Re

Essayes avec un fichier texte juste créé pour le test
(C'est ce que j'ai fait et cela fonctionne)
A partir d'Excel, j'ai sauvegardé une feuille avec 5 colonnes dans lequel j'avais saisi des nombres digitaux.
(du style : 158.56 1458.23 etc...)
La macro de mon message précédent a bien importé le fichier et convertit le point en virgule.
 

tmbangue

XLDnaute Nouveau
Re

Alors oui ça fonctionne mais le problème c'est que j'aimerais pouvoir faire cette manœuvre avec un nom différent à chaque fois c'est le problème.

Le fichier ne s'appellera pas tout le temps "test" et il ne se trouvera pas forcément dans le même chemin.
Savez-vous comment je peux procéder ?
 

job75

XLDnaute Barbatruc
Bonjour tmbangue, Modeste geedee, JM,

Une macro très classique :
VB:
Sub ImportFichierTexte()
Dim fichier As Variant, tablo, ncol%, sep$, i&, j%, x$
fichier = Application.GetOpenFilename 'choix du fichier
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(fichier).Sheets(1)
    tablo = .UsedRange
    If Not IsArray(tablo) Then tablo = .UsedRange.Resize(2)
    .Parent.Close False
End With
'---traitement du tableau---
ncol = UBound(tablo, 2)
sep = Application.DecimalSeparator
For i = 1 To UBound(tablo)
    For j = 1 To ncol
        x = Replace(tablo(i, j), ".", sep)
        If IsNumeric(x) Then tablo(i, j) = CDbl(x)
Next j, i
'---restitution---
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Cells.Clear 'RAZ
[A1].Resize(UBound(tablo), ncol) = tablo
ActiveSheet.UsedRange.Columns.AutoFit 'actualisation des barres de défilement + largeur des colonnes
End Sub
A+
 

job75

XLDnaute Barbatruc
Cette macro est nettement plus simple :
VB:
Sub ImportFichierTexte()
Dim fichier As Variant, F As Worksheet
fichier = Application.GetOpenFilename 'choix du fichier
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Set F = ActiveSheet
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
F.Cells.Clear 'RAZ
With Workbooks.Open(fichier).Sheets(1).UsedRange
    .Replace ".", ".", xlPart 'remplace le point par... le point
    .Copy F.[A1]
    .Parent.Parent.Close False
End With
F.UsedRange.Columns.AutoFit 'actualisation des barres de défilement + largeur des colonnes
End Sub
 

tmbangue

XLDnaute Nouveau
Cette macro est nettement plus simple :
VB:
Sub ImportFichierTexte()
Dim fichier As Variant, F As Worksheet
fichier = Application.GetOpenFilename 'choix du fichier
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Set F = ActiveSheet
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
F.Cells.Clear 'RAZ
With Workbooks.Open(fichier).Sheets(1).UsedRange
    .Replace ".", ".", xlPart 'remplace le point par... le point
    .Copy F.[A1]
    .Parent.Parent.Close False
End With
F.UsedRange.Columns.AutoFit 'actualisation des barres de défilement + largeur des colonnes
End Sub


Merci Job pour ta réponse rapide et précise j'ai pu résoudre mon problème très facilement grâce à ta macro merci beaucoup !!
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, tmbangue, Modeste geedee, job75

J'ai repris mon code en complétant* Application.GetOpenFilename utilisé par job75.
(* complément simplement ergonomique)
VB:
Sub Import_TXT_II()
Dim fichier As Variant
fichier = _
      Application.GetOpenFilename(FileFilter:="Fichiers Texte (*.txt; *.csv),*.txt;*.csv", _
      Title:="Sélectionner le fichier", MultiSelect:=False)
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fichier, Destination:=Range("$A$1"))
        .Name = "tests"
        .FieldNames = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileTabDelimiter = True
        .TextFileDecimalSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re, Bonsoir Job75

Oui, mais je propose juste mon code modifié après avoir lu le tien (simple association d'idée)
sans autre but que compléter mon code initial.
Cela intéressa peut-être le demandeur ou un autre membre qui passerait dans ce fil.

Il y a plusieurs propositions dans ce fil.
Libre à chacun d'en faire ce qu'il veut... ou pas. ;)

Maintenant pour revenir au thème de la question, si tu le permets j'ai une question.
Qu'est-ce qui fait que tu ne retiens pas la possibilité offerte par ActiveSheet.QueryTables?
rapidité d’exécution?

J'ai choisi cette méthode parce qu'elle permet directement le remplacement du point par la virgule
(il y aussi d'autres paramètres qui peuvent être intéressant à l'usage)
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 913
Membres
101 837
dernier inscrit
Ugo