Routine avec boucle pour exportation en fichier texte

Le 02/01/2020 à 09:31

Bonjour à tous et meilleures voeux.

J'ai besoin de faire une routine pour éviter de faire une répétition d'étapes à la main.

J'ai un tableau (fichier ci-joint) avec 2 colonnes, et j'ai besoin de reprendre ces données pour créer un script pour un autre programme.

Il faudrait que la longueur de la colonne soit automatiquement prise en compte.

exemple du texte final :

si variable1= (valeur A1) then

variable2 = (valeur B1)

endif

si variable1= (valeur A2) then

variable2 = (valeur B2)

endif

etc.....

Et ensuite, une exportation en format texte pour copier/coller directement dans le programme.

Merci d'avance.

5temps-dist.xlsx (8.22 Ko)
Le 02/01/2020 à 10:08

Bonjour Absou, bonjour le forum,

le code ci-dessous renvoie le texte dans la variable MSG.

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = 2 To DL 'boucle sur toutes les lignes I de 2 à DL
    'définit le message MSG
    MSG = IIf(MSG = "", "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B"), MSG & Chr(13) & "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B"))
Next I 'prochaine ligne de la boucle
MsgBox MSG 'affiche le message msg
End Sub

Je te laisse faire l'exportation en fichier texte, je ne sais pas faire...

Le 02/01/2020 à 10:47

Merci ThauThème pour cette réponse rapide.

A défaut d'exporter le contenu de "MSG" sous forme de texte, le fait de copier le contenu m'irait très bien, ensuite je collerais à la main.

J'ai recherché sur le net, mais je n'ai rien trouvé de concluant.

Si quelqu'un à la réponse.

En vous remerciant par avance.

Le 02/01/2020 à 12:05

Re,

Le code modifié. MSG est copié dans le presse-papier :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim x As New DataObject 'déclare la variable X

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = 2 To DL 'boucle sur toutes les lignes I de 2 à DL
    'définit le message MSG
    MSG = IIf(MSG = "", "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B"), MSG & Chr(13) & "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B"))
Next I 'prochaine ligne de la boucle
x.SetText MSG 'récupère le texte du message MSG dans x
x.PutInClipboard 'renvoie x dans le presse-papier
End Sub

Attention ! Après une heure de galère où ça ne fonctionnait pas, j'ai lu qu'il fallait cocher la référence : Microsoft Forms 2.0 Object Library

Pour cela :

1. Entre dans VBE (l'éditeur VBA) [Alt]+[F11]

2. Menu Outils / Références...

3. Rechercher et cocher Microsoft Forms 2.0 Object Library

Il ne te restera plus qu'à faire Coller ou [Ctrl]+[V]...

Le 02/01/2020 à 12:25

En réfléchissant à tête reposée, j'ai trouvé.

Il faut charger la bibliothèque "Microsoft Forms 2.0 Object Library".

J'ai modifié un peu le script.

Le nom des variables est repris directement depuis une cellule.

Et j'ai rajouté des mise à la ligne.

Résultat dans le fichier ci-joint.

Ca fonctionne, ça copie ce qu'il y a dans "MSG"' et ensuite je le colle dans une autre feuille, je le copie et je le colle dans note. Et ça garde la mise en forme.

Pour essayer d'être encore plus efficace, j'ai rajouté des lignes pour copier / coller / copier.

Comme je ne sais pas coder, j'ai enregistré et ensuite j'ai fait la manip, ce qui m'a donné le script, et j'ai collé, mais ça ne fonctionne pas.

Ce sont les lignes mises en commentaire à la fin du script.

2temps-dist.xlsx (9.59 Ko)
Le 02/01/2020 à 13:42

Re,

Il te faut enregistrer ton fichier sous .xlsm si tu veux qu'on ait le code...

Le 02/01/2020 à 13:48

Oups, désolé.

Je remets le fichier.

Merci ThauThème pour ton aide

6temps-dist.xlsm (9.61 Ko)
Le 02/01/2020 à 14:01

Salut tout le monde,

Bonne année.

Pour écrire un fichier texte :

Public Function WriteFile(Fic As String, Texte As String) As Boolean
Dim Nb As Integer
    On Error GoTo Fin
        Nb = FreeFile
        Open Fic For Output As #Nb
            Print #Nb, Texte
        Close #Nb
        WriteFile = True
Fin:
    On Error GoTo 0
End Function

A utiliser, par exemple, comme ceci :

Sub Essai()
Dim b As Boolean
    b = WriteFile("C:\test.txt", "toto") 'mettre le chemin complet "C:\Blabla\Blibli\toto.txt"
    If b Then MsgBox "Fichier bien écrit"
End Sub

Ce qui fait, avec le code de l'ami Thauthème :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim x As New DataObject 'déclare la variable X
Dim b As Boolean

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = 2 To DL 'boucle sur toutes les lignes I de 2 à DL
    'définit le message MSG
    MSG = IIf(MSG = "", "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B"), MSG & Chr(13) & "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B"))
Next I 'prochaine ligne de la boucle
    b = WriteFile("C:\test.txt", MSG)
    If b Then MsgBox "Fichier bien écrit"
End Sub

Petite modif du code de ThauThème (évite le Iif en boucle) :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim b As Boolean

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet O
MSG = "Si Variable1 = " & O.Cells(2, "A") & " Then Variable2 = " & O.Cells(2, "B") 'remplit la variable de la deuxième ligne
For I = 3 To DL 'boucle sur toutes les lignes I de 3 à DL
    'définit le message MSG
    MSG = MSG & Chr(13) & "Si Variable1 = " & O.Cells(I, "A") & " Then Variable2 = " & O.Cells(I, "B")
Next I 'prochaine ligne de la boucle
    b = WriteFile("C:\test.txt", MSG)
    If b Then MsgBox "Fichier bien écrit"
End Sub

EDIT : dernier code après consultation des résultats souhaités :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim b As Boolean

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet O
MSG = "Si temps = " & O.Cells(2, "A") & " Then" & vbCr & "distance = " & O.Cells(2, "B") & vbCr & "endif" & vbCr  'remplit la variable de la deuxième ligne
For I = 3 To DL 'boucle sur toutes les lignes I de 3 à DL
    'définit le message MSG
    MSG = MSG & vbCr & "Si temps = " & O.Cells(I, "A") & " Then" & vbCr & "distance = " & O.Cells(I, "B") & vbCr & "endif" & vbCr
Next I 'prochaine ligne de la boucle
    b = WriteFile("C:\test.txt", MSG)
    If b Then MsgBox "Fichier bien écrit"
End Sub
Le 02/01/2020 à 17:40

Merci Franck pour cette réponse.

Si je lance le script, ça m'affiche le message suivant :

Erreur de compilation:

Sub ou Function non définie

Et ça surligne en jaune "WriteFile"

Que veut dire ce message d'erreur ?

Si j'enlève la ligne

 b = WriteFile("C:\test.txt", MSG)

Tout fonctionne bien

Le 02/01/2020 à 19:07

Re,

Absou a écrit :

Oups, désolé.

Je remets le fichier.

Merci ThauThème pour ton aide

Tu as remis un fichier .xlsm certes, mais toujours sans le code qui posait problème. On ne pourra donc pas te dire ce qui n'allait pas...

Mais il semblerait que Franck (Pijaku, qui sévit aussi sur d'autres forums) t'ait fourni une réponse qui correspond à tes attentes...

Le 03/01/2020 à 07:59

J'espère que cette fois le fichier contient bien la macro.

Au cas où, ci-dessous le code

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim b As Boolean
Dim x As New DataObject 'déclare la variable X

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet O
MSG = "Si " & O.Cells("1", "E") & "= " & O.Cells(2, "A") & " Then " & vbCr & O.Cells("2", "E") & "= " & O.Cells(2, "B") & vbCr & "endif" & vbCr  'remplit la variable de la deuxième ligne
For I = 3 To DL 'boucle sur toutes les lignes I de 3 à DL
    'définit le message MSG
    MSG = MSG & vbCr & "Si temps = " & O.Cells(I, "A") & " Then" & vbCr & "distance = " & O.Cells(I, "B") & vbCr & "endif" & vbCr
Next I 'prochaine ligne de la boucle

x.SetText MSG 'récupère le texte du message MSG dans x
x.PutInClipboard 'renvoie x dans le presse-papier

' NE FONCTIONNE PAS
'b = WriteFile("C:\test.txt", MSG)
  '  If b Then MsgBox "Fichier bien écrit"

End Sub

Le nom des variables est directement repris par une cellule.

La copie fonctionne bien, mais comme indiqué dans un de mes message précédent, la sauvegarde sous forme de fichier texte ne fonctionne pas

Si je lance le script, ça m'affiche le message suivant :

Erreur de compilation:

Sub ou Function non définie

Et ça surligne en jaune "WriteFile"

Que veut dire ce message d'erreur ?

Si j'enlève la ligne

b = WriteFile("C:\test.txt", MSG)

Tout fonctionne bien

En tout cas, merci beaucoup, vous m'avez fait gagner beaucoup de temps.

1temps-dist-copie.xlsm (17.12 Ko)
Le 03/01/2020 à 08:19

Bonjour,

Je t'ai donné deux codes principaux.

Une Sub nommée Macro1 et une fonction nommé WriteFile.

Il faut que tu places les deux dans ton module.

Soit, le code total :

Public Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim b As Boolean

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet O
MSG = "Si temps = " & O.Cells(2, "A") & " Then" & vbCr & "distance = " & O.Cells(2, "B") & vbCr & "endif" & vbCr  'remplit la variable de la deuxième ligne
For I = 3 To DL 'boucle sur toutes les lignes I de 3 à DL
    'définit le message MSG
    MSG = MSG & vbCr & "Si temps = " & O.Cells(I, "A") & " Then" & vbCr & "distance = " & O.Cells(I, "B") & vbCr & "endif" & vbCr
Next I 'prochaine ligne de la boucle
    b = WriteFile("C:\test.txt", MSG)  'écrit le fichier texte grâce à la fonction WriteFile ci-dessous (remplacer C:\text.txt par le chemin voulu + nom du fichier txt
    If b Then MsgBox "Fichier bien écrit" ' t'avertit si tout s'est déroulé correctement (pas très utile mais...)
End Sub

Public Function WriteFile(Fic As String, Texte As String) As Boolean
Dim Nb As Integer
    On Error GoTo Fin
        Nb = FreeFile
        Open Fic For Output As #Nb
            Print #Nb, Texte
        Close #Nb
        WriteFile = True
Fin:
    On Error GoTo 0
End Function

Tu lances ta macro et c'est tout.

ps : amitiés à Thauthème

Le 03/01/2020 à 08:19

Bonjour à tous,

Si cela fonctionne, mais tu n'as pas mis la fonction

Avec ma copie du classeur, après avoir créé un fichier que tu nommes Test.txt et que tu places dans le même dossier que ce classeur, fais un test

6temps-dist-copie.xlsm (26.36 Ko)
Le 03/01/2020 à 08:36

@M12,

Bonjour,

après avoir créé un fichier que tu nommes Test.txt

Pas vraiment.

Si le fichier n'existe pas, il sera créé

Le 03/01/2020 à 09:20

Bonjour Pijaku

Autant pour moi, tu as raison

Le 03/01/2020 à 19:33

Ca fonctionne,

Merci tous.

Rechercher des sujets similaires à "routine boucle exportation fichier texte"