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

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas