XL 2016 Générer fichier .txt à partir d'une feuille Excel

D10

XLDnaute Junior
Bonsoir,

J'ai un fichier Excel qui se présente de cette façon:
Colonne A: des dates
Colonne B, C et D, des noms
Colonne E, un nombre

j'ai mis un exemple en pièce jointe

J'aimerai à partir de ce fichier, obtenir un fichier texte qui me donnerait (si on se base sur le fichier d'exemple) quelque chose comme ça:
1- Il faudrait déjà que la macro repère la date du jour
2- une fois que la date du jour est repérée créer un fichier texte qui se présenterait comme ceci:

YYY:
AA - France - 3

ZZZ:
BB - Italie - 2

XXX:
CCC - Espagne - 1

En espérant avoir été le plus clair possible

merci d'avance et bonne soirée ! :)
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonsoir D10,
VB:
Sub FichierTexte()
Dim i As Variant, P As Range, n&
i = Application.Match(CDbl(Date), [A:A], 0)
If IsError(i) Then MsgBox "Date du jour inexistante...": Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set P = Cells(i, 1).MergeArea
Workbooks.Add 'nouveau document
n = 1
For i = 1 To P.Rows.Count
    Cells(n, 1) = P(i, 2) & " :"
    Cells(n + 1, 1) = P(i, 3) & " - " & P(i, 4) & " - " & P(i, 5)
    n = n + 3
Next
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Fichier texte " & Format(Date, "yyyy-mm-dd"), xlText
ActiveWorkbook.Close
End Sub
Et bonne nuit.
 

D10

XLDnaute Junior
Bonjour et merci beaucoup pour votre aide ! :)
Cela marche pas mal, mais le code ne génère pas de fichier .txt mais une feuille excel :(
 

job75

XLDnaute Barbatruc
le code ne génère pas de fichier .txt mais une feuille excel :(
Curieux car chez moi sur Win 10 - Excel 2013 il n'y a aucun problème.

Je n'avais pas précisé l'extension .txt du fichier car normalement ce n'est pas nécessaire, mais essayez alors :
VB:
Sub FichierTexte()
Dim i As Variant, P As Range, n&
i = Application.Match(CDbl(Date), [A:A], 0)
If IsError(i) Then MsgBox "Date du jour inexistante...": Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set P = Cells(i, 1).MergeArea
Workbooks.Add 'nouveau document
n = 1
For i = 1 To P.Rows.Count
    Cells(n, 1) = P(i, 2) & " :"
    Cells(n + 1, 1) = P(i, 3) & " - " & P(i, 4) & " - " & P(i, 5)
    n = n + 3
Next
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Fichier texte " & Format(Date, "yyyy-mm-dd") & ".txt", xlText
ActiveWorkbook.Close
End Sub
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour zebanx,

Une autre solution dans ce fichier (2) avec l'ouverture de la boîte de dialogue "Enregistrer sous" :
VB:
Sub FichierTexte()
Dim i As Variant, P As Range, fichier As Variant
i = Application.Match(CDbl(Date), [A:A], 0)
If IsError(i) Then MsgBox "Date du jour inexistante...": Exit Sub
Set P = Cells(i, 1).MergeArea
ChDir ThisWorkbook.Path 'dossier affiché, à adapter
fichier = "Fichier texte " & Format(Date, "yyyy-mm-dd")
fichier = Application.GetSaveAsFilename(fichier, "Text Files (*.txt), *.txt")
If fichier = False Then Exit Sub
Open fichier For Output As #1
For i = 1 To P.Rows.Count
    Print #1, P(i, 2) & " :" & vbCrLf & P(i, 3) & " - " & P(i, 4) & " - " & P(i, 5) & vbCrLf
Next
Close #1
End Sub
A+
 

Fichiers joints

Discussions similaires


Haut Bas