Enregistrer le contenu d'une cellule dans un fichier .txt

Résolu

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention -
Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention - 7 oct. 2015 à 12:00

Bonjour,

Je cherche par le biais d'un macro :
- à copier ou extraire le contenu d'une cellule (la cellule contient une formule, il faut copier le résultat et non la formule si c'est possible, sinon je passerai par un copier/coller la valeur)
- et "le coller" ou "l'exporter" dans un fichier .txt déjà existant.

J'ai plusieurs cellules dans le même fichier sur lesquelles je dois appliquer cette action C2;C3;C4;C5;C6;G2;G3;G4;G5;...
et chaque cellule à bien un fichier .txt de destination différent.
S'il y a une astuce pour ne pas devoir faire un code par cellule, ça serait génial.

Merci d'avance.
Cordialement.
Ben.

Afficher la suite

A voir également:

Enregistrer le contenu d'une cellule dans un fichier .txt
Fichier bin - Guide
Comment réduire la taille d'un fichier - Guide
Comment ouvrir un fichier epub ? - Guide
Audacity enregistrer son pc - Guide
Fichier rar - Guide

6 réponses

Réponse 1 / 6

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour,

Il te faut créer un tableau avec tes adresses à exporter et un tableau avec les chemins des fichiers correspondants et ensuite tu parcours tes tableaux :

Public Sub test()
Dim tba, tbc, idx
tba = Split("C2;C3;C4;C5;C6;G2;G3;G4;G5",";")
tbc = Split("C:\f2.txt;C:\f3.txt;C:\f4.txt;C:\f5.txt;C:\f6.txt;C:\g2.txt;C:\g3.txt;C:\g4.txt;C:\g5.txt", ";")
For idx = 0 To UBound(tba)
    Open tbc(idx) For Append As #1 '  chemin
    Print #1, Range(tba(idx)).Value
    Close #1
Next idx
End Sub

Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer. Antoine de Saint-Exupéry

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Bonjour,
je viens seulement de voir ta réponse... :-(
je ne comprend pas ce que tu veux dire en avec:
"Il te faut créer un tableau avec tes adresses à exporter et un tableau avec les chemins des fichiers correspondants et ensuite tu parcours tes tableaux"

J'ai appliqué la macro que tu proposes, il y a 2 petit problème :
- la macro copie la formule et non la valeur
- il faudrait qu'a chaque fois que j'applique la macro, ça remplace le contenu dans le fichier txt, car actuellement ça s'ajoute à la suite...
merci d'avance.

Réponse 2 / 6

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour,

Je vois que tous les problèmes ne sont pas urgents à la minute....

- la macro copie la formule et non la valeur
Si tu peux le prouver, cela sera une belle découverte car jusqu'à maintenant je n'ai jamais vu une formule fonctionner dans un fichier texte : donne moi un exemple.

- il faudrait qu'a chaque fois que j'applique la macro, ça remplace le contenu dans le fichier txt
Comme ton fichier existait je pensais que tu voulais garder l'historique. Tu remplaces cette ligne tout simplement :

    Open tbc(idx) For Output As #1 '  chemin

Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer. Antoine de Saint-Exupéry

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Bonjour,
Oh non ! rien d'urgent, le principal est de finir par arriver à mes fins,
merci beaucoup de te pencher sur mon problème.

La modification que tu as apporté est exactement ce que j'attendais. super

J'ai encore un petit souci, mon tableau excel contient des valeurs avec 3 chiffres après la virgules, mais la macro ne prend pas les 0 en fin exple: 1,320 devient 1,32 y a t-il une astuce pour garder le texte complet : 1.320?

Peux tu me dire pourquoi tu as mis << ' chemin >> à la fin de la ligne ?
Est-ce que ça veut dire que l'on peut changer le chemin de destination des fichiers texte en une fois ? Car mon chemin est assez long...

la solution est peut etre dans ta phrase : "Il te faut créer un tableau avec tes adresses à exporter et un tableau avec les chemins des fichiers correspondants et ensuite tu parcours tes tableaux" mais je ne comprend pas ce que tu veux dire par là...

Encore merci de ton aide.
Bien cordialement

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour,

y a t-il une astuce pour garder le texte complet : 1.320
Il faut modifier l'écriture

Print #1, format(Range(tba(idx)).Value,"0.000")

pourquoi tu as mis << ' chemin >> à la fin de la ligne ?
C'est simplement un commentaire mais l'on peut changer le chemin de destination des fichiers texte en une fois par exemple :

Public Sub test()
Dim tba, tbc, idx as integer
const rep = "C:\ton chemin complet"
tba = Split("C2;C3;C4;C5;C6;G2;G3;G4;G5",";")
tbc = Split("\f2.txt;\f3.txt;\f4.txt;\f5.txt;\f6.txt;\g2.txt;\g3.txt;\g4.txt;\g5.txt", ";")
For idx = 0 To UBound(tba)
    Open rep & tbc(idx) For Append As #1 '  chemin
    Print #1, format(Range(tba(idx)).Value,"0.000")
    Close #1
Next idx
End Sub

je ne comprend pas ce que tu veux dire par là...
C'est ce que fait la macro avec

tba = Split("C2;C3;C4;C5;C6;G2;G3;G4;G5",";")
tbc = Split("\f2.txt;\f3.txt;\f4.txt;\f5.txt;\f6.txt;\g2.txt;\g3.txt;\g4.txt;\g5.txt", ";")

tu crées les tableaux puis

For ... Next

parcours tes tableaux"

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Super, ça fonctionne.

Pour un peu plus de simplicité, j'aimerai faire la même chose avec plusieurs cellules.
séparé par un retour à la ligne dans le txt

J'ai essayé de remplacer C2;C3;C4;C5;C6 par C2:C6, mais ca ne fonctionne pas.

Une idée, aussi lumineuse que les autres ?

Merci de ton aide.

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724 > Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention

Bonjour,

Ton idée ne peux pas fonctionner effectivement mais avec un peu de changement :

Public Sub test()
Dim tba, tbc, idx as integer, elm as range
const rep = "C:\ton chemin complet"
tba = Split("C2:C6;C3;C4;C5;C6;G2;G3;G4;G5",";")
tbc = Split("\f2.txt;\f3.txt;\f4.txt;\f5.txt;\f6.txt;\g2.txt;\g3.txt;\g4.txt;\g5.txt", ";")
For idx = 0 To UBound(tba)
    Open rep & tbc(idx) For Append As #1 '  chemin
    for each elm in Range(tba(idx))
        Print #1, format(elm.Value,"0.000")
    next elm
    Close #1
Next idx
End Sub

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Bonjour,
Merci de ton aide, ca marche impeccable ! un projet bientôt terminé, et une démarche qui va me permettre de solutionner plein de chose en cour

En vu de décliner pour un autre fichier, que faut-il modifier pour envoyer la plage C2:F2 avec dans un txt, cette fois sur sans retour à la ligne entre les cellules mais avec un espace ou un signe comme séparateur (pour y ajouter un code AINSI par exple)

Et tu me vois venir?! si je peux avoir C2:E4 sous la forme :
C2 D2 E2
C3 D3 E3
C4 D4 E4

Ca serait vraiment génial

Cordialement

Merci encore je vais gagner plein de temps maintenant. !

Réponse 3 / 6

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Pour la sélection jusqu'à la dernière cellule non vide j'ai tenté ca, mais je ne sais pas comment écrire l'adresse de la cellule "BDerLigne"

Sub test()
Dim DerLigne, tba, tbc, idx As Integer, elm As Range
Const rep = "D:\test"

'DerLigne : Numéro de la dernière ligne remplie
DerLigne = Range("A" & Rows.Count).End(xlUp).Row

tba = Split("B2:BDerLigne", ";")
tbc = Split("\test.txt", ";")

For idx = 0 To UBound(tba)
Open rep & tbc(idx) For Output As #1 ' chemin
For Each elm In Range(tba(idx))
Print #1, Format(elm.Value, "0.000")
Next elm
Close #1
Next idx

'affiche en A1 la valeur de la variable DerCell
Range("A1").Value = DerLigne

End Sub

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonsoir Bemanace,

Cela fait pas mal de modifications pas toujours évidentes :

- j'ai l'impression qu'il y a une nombre de caractère maximum
oui effectivement, c'est 256 affichables (voir ici) mais j'ai corrigé : ce sera la limite de la cellule 32767 caractères.

- de C2 à la dernière cellule non vide
J'ai remplacé la dernière ligne de la plage par ">", mais il faut une plage sinon il manque le début : C2:C> (1 colonne) ou C2:E> (3 colonnes).

- a quel endroit j'indique dans ma macro sur quelle feuille aller
Avec la notation classique c'est le plus simple : Feuil1!C2:G12 sinon c'est la feuille active qui est prise en compte.

- combiner plusieurs cellules ou plages
Oui, bien sûr mais au lieu du & utilises la virgule qui est le séparateur natif des plages.

Voilà, dans la macro suivante toutes tes idées sont prises en compte, et je t'ai mis les divers paramétrages dans mes paramètres de test :

Option Explicit
Public Sub test()
Dim tba, tbc, tbm, idx As Integer, elm As Range, lig As Long, idp As Long, man As String
Const rep = "D:\test"
Const flg = ">" ' code pour copier jusqu'à la dernière ligne non vide mettre ce caractère en fin de plage
tba = Split("Feuil3!C2:E>,Feuil3!H2:H>;Feuil1!C2:G12", ";")
tbc = Split("\f2.txt;\f3.txt", ";")
For idx = 0 To UBound(tba)
    Open rep & tbc(idx) For Append As #1
    Print #1,
    Print #1, Format(Date, "dd/mm/yyyy")   'date
    tbm = Split(tba(idx), ",")
    For idp = 0 To UBound(tbm)
        If InStr(1, tbm(idp), flg) > 0 Then
            If InStr(1, tbm(idp), ":") > 0 Then
                man = Left(tbm(idp), InStr(1, tbm(idp), ":") - 1)
                While Right(man, 1) <= 9
                    man = Left(man, Len(man) - 1)
                Wend
                lig = Range(man & Rows.Count).End(xlUp).Row
                tbm(idp) = Replace(tbm(idp), flg, lig)
            Else
                MsgBox "Paramètre erroné : " & tba(idx)
                Exit Sub
            End If
        End If
    Next idp
    lig = 0
    tba(idx) = Join(tbm, ",")
    For Each elm In Range(tba(idx))
        If lig = 0 Then
            lig = elm.Row
        Else
            If lig <> elm.Row Then lig = elm.Row: Print #1,
        End If
        If Len(elm.Value) < 255 Then
            Print #1, Format(elm.Value, "0.000") & " | "; ' | séparation
        Else
            idp = 1
            While idp < Len(elm.Value)
                Print #1, Mid(elm.Value, idp, 255);
                idp = idp + 255
            Wend
            Print #1,
        End If
    Next elm
    Close #1
Next idx
End Sub

Bon test et bonne soirée.

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9 > gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention

whaou ! effectivement le code à pris pas mal de ligne d'un coup !
Je me plonge dans les tests !
Merci beaucoup

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Fantastique !
question : (je vais pas dire la dernière, on sait jamais... !)

Est-il possible de ne pas avoir de marquage de séparation quand il n'y à qu'une colonne dans la sélection.
A2:A5
donne actuellement :
A2 I
A3 I
A4 I

J'aimerai
A2
A3
A4

Pour plus de facilité, s'il faut, on peut avoir 2 macros différentes. Jusque là j'avais réussit à adapter, pour les 2 fichiers, mais là, je n'y arrive pas... j'ai que des lignes vides

Très bonne soirée !
et un grand merci.

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724 > Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention

Bonsoir Bemanace,

Pour cela, tu remplaces ces lignes :

            If lig <> elm.Row Then lig = elm.Row: Print #1,
        End If
        If Len(elm.Value) < 255 Then
            Print #1, Format(elm.Value, "0.000") & " | "; ' | séparation

par celles-ci :

            If lig <> elm.Row Then lig = elm.Row: If man <> 1 Then Print #1,
        End If
        If Len(elm.Value) < 255 Then
            Print #1, Format(elm.Value, "0.000");
            For idp = 0 To UBound(tbm)
                If Not Intersect(Range(tbm(idp)), elm) Is Nothing Then
                    man = Range(tbm(idp)).Columns.Count
                    If man = 1 Then Print #1, Else Print #1, " | ";                        ' | séparation
                End If
            Next idp

La macro s'étoffe en même temps que les fonctionnalités...
Bon test

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Merci gbinforme
J'ai fait la modif, la marque de séparation à bien disparu, mais il y a maintenant une ligne vide qui vient s'ajouter entre les lignes des cellules...

c2

c3

c4

Réponse 4 / 6

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

En fait le ;G12 n'était pas le problème
c'est le changement de feuille pour le meme ficher texte qu'il n'aime pas

Ne fonctionne pas :

tba = Split("Feuil1!A2,Feuil2!B6", ";")

Fonctionne :

tba = Split("Feuil1!A2,B6", ";")

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Voici mon code complet :

Option Explicit
Public Sub test()
Dim tba, tbc, tbm, idx As Integer, elm As Range, lig As Long, idp As Long, man As String
Const rep = "D:\test" 'chemin
Const flg = ">" ' code pour copier jusqu'à la dernière ligne non vide mettre ce caractère en fin de plage


'fonctionne
'tba = Split("CodesExport!A2:A5;Feuil1!AA1", ";")

'ne fonctionne pas
tba = Split("CodesExport!A2:A5,Feuil1!AA1;Feuil1!AA3", ";")


'NOMENCLATURE
'Feuil1!H2 = la cellule H2 de la Feuil1
'    C2:G4 = De C2 à G4
'    B4,C2 = B4 ET C2
'    C2:E> = de C2 à la dernière cellule non vide de la colonne E




tbc = Split("\Titre.txt;\Prog.txt", ";")
For idx = 0 To UBound(tba)
    Open rep & tbc(idx) For Output As #1
    'Print #1,
    'Print #1, Format(Date, "dd/mm/yyyy")   'insere la date
    tbm = Split(tba(idx), ",")
    For idp = 0 To UBound(tbm)
        If InStr(1, tbm(idp), flg) > 0 Then
            If InStr(1, tbm(idp), ":") > 0 Then
                man = Left(tbm(idp), InStr(1, tbm(idp), ":") - 1)
                While Right(man, 1) <= 9
                    man = Left(man, Len(man) - 1)
                Wend
                lig = Range(man & Rows.Count).End(xlUp).Row
                tbm(idp) = Replace(tbm(idp), flg, lig)
            Else
                MsgBox "Paramètre erroné : " & tba(idx)
                Exit Sub
            End If
        End If
    Next idp
    lig = 0
    tba(idx) = Join(tbm, ",")

'l'erreur est sur la ligne suivante :
    For Each elm In Range(tba(idx))
        If lig = 0 Then
            lig = elm.Row
        Else
            If lig <> elm.Row Then lig = elm.Row: If man <> 1 Then Print #1,
        End If
        If Len(elm.Value) < 255 Then
            Print #1, Format(elm.Value, "0.000");
            For idp = 0 To UBound(tbm)
                If Not Intersect(Range(tbm(idp)), elm) Is Nothing Then
                    man = Range(tbm(idp)).Columns.Count
                    If man = 1 Then Print #1, Else Print #1, " | ";                        ' | séparation
                End If
            Next idp

        Else
            idp = 1
            While idp < Len(elm.Value)
                Print #1, Mid(elm.Value, idp, 255);
                idp = idp + 255
            Wend
            Print #1,
        End If
    Next elm
    Close #1
Next idx
End Sub

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour Bemanace,

Ne fonctionne pas :
tba = Split("Feuil1!A2,Feuil2!B6", ";")

Fonctionne :
tba = Split("Feuil1!A2,B6", ";")

J'avais mal interprété ta question : tu ne peux pas sélectionner 2 plages de 2 feuilles différentes. Si tu essayes sur tes feuilles manuellement tu verras le dysfonctionnement.
Pour le faire, tu mets un point virgule :

tba = Split("CodesExport!A2:A5;Feuil1!AA1;Feuil1!AA3", ";")

et tu doubles ton fichier que tu ouvres en append après l'avoir virginisé par cette séquence :

tbc = Split("\Titre.txt;\Titre.txt;\Prog.txt", ";")
For idx = 0 To UBound(tbc)
    Open rep & tbc(idx) For Output As #1
    Close #1
Next idx
For idx = 0 To UBound(tba)
    Open rep & tbc(idx) For Append As #1

qui remplace

tbc = Split("\Titre.txt;\Prog.txt", ";")
For idx = 0 To UBound(tba)
    Open rep & tbc(idx) For Output As #1

Bonne journée

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Bonjour gbinforme,
c'est vrai ça, je n'avais pas pensé que ça n'était pas possible à main la sélection sur plusieurs feuil... !

C'est génial, j'apprend plein de chose ! je ne sais pas comment te remercier !?

Ça fonctionne impeccable avec la "virginisation" !

Plus ça va et moins je suis obligé d'intervenir manuellement dans le résultat.
Il reste juste une ligne vide a la fin de chaque fichier, que je dois enlever.
J'ai essayé de repérer un Print #1 qui pourrait en être la cause, mais ca n'a pas l'air d'être ca...

Y a t-il une astuce ?

Bonne fin de journée.

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour Bemanace,

une ligne vide a la fin de chaque fichier
ne serais-ce pas une cellule vide ?
Moi je n'ai pas de ligne vide : as-tu regardé avec un vrai éditeur comme Notepad++ ?

Bonne soirée.

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9 > gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention

Bonjour,
ca ne vient pas d'une cellule vide, j'ai fait le test en exportant une seule cellule, et j'ai le même problème.

Quand j'ouvre mon txt (dans bloc note) ou que je l'importe dans indesign,
j'ai un retour à la ligne à la fin de mon texte, qui me créé donc une ligne vide.

test

Etrange...

Réponse 6 / 6

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour Bemanace,

Voilà ce que cela donne sur Notepad++ :

En informatique, CRLF (ou CR+LF), est une séquence de deux octets qui indique une fin de la ligne (et surtout une nouvelle ligne) dans un texte(source).

Dans le bloc note il n'y a qu'une ligne mais je n'ai pas indesign pour tester. Si tu y tiens vraiment l'on peut rajouter une séquence pour l'enlever mais avec certains logiciels tu auras des soucis car ton fichier texte ne sera pas normalisé.
à toi de dire.
Bonne soirée.

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9

Bonjour gbinforme,

c'est donc ce LF qui créé une nouvelle ligne qui pose problème...

S'il existe la possibilité de le supprimer je veux bien essayer, mais je ne veux pas que ce soit trop prise de tête pour toi, au cas ou ça ne fonctionnerait pas, ça serait dommage d'avoir passé trop de temps...

Bonne journée.

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour Bemanace,

c'est donc ce LF qui créé une nouvelle ligne qui pose problème...
Ce n'est pas exact car ce code correspond parfaitement au standard d'un fichier texte.

Pour enlever le dernier code que ton logiciel ne sait pas traiter je te propose de rajouter ou modifier les lignes surlignées :

Dim tba, tbc, tbm, idx As Integer, elm As Range, lig As Long, idp As Long, man As String
Dim nel As Integer
Const rep = "D:\test" 'chemin

    nel = Range(tba(idx)).Count
    For Each elm In Range(tba(idx))

        Else
            If lig <> elm.Row Then lig = elm.Row: If man <> 1 Then If (nel And idx <> UBound(tba)) Then Print #1,
        End If

                    man = Range(tbm(idp)).Columns.Count
                    If man <> 1 Then Print #1, " | "; Else: If (nel And idx <> UBound(tba)) Then Print #1,
                End If

            Wend
            If (nel And idx <> UBound(tba)) Then Print #1,
        End If

Bon test et bonne soirée.

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Ps: il manque une ligne dans le second :

    nel = Range(tba(idx)).Count
    For Each elm In Range(tba(idx))
        nel = nel - 1

Bonne nuit.

Bemanace Messages postés 60 Date d'inscription Statut Membre Dernière intervention 9 > gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention

T'es un dieu ! çà marche !
Merci

Discussions similaires

Excel : colorer une cellule sous condition d'une autre ?

Votre réponse

Discussions similaires