XL 2019 Problème d'export fichier xls en txt

[LLB29]

Bonjour,

Je sollicite à nouveau l'aide du forum. J'espère ne pas trop vous perdre dans mes explications...
J'expose mon souci:

Objectif:
1) Importer le fichier txt (fichier "Test à importer") sous excel (fichier "Test") avec une macro
2) Supprimer des lignes qui ne m'intéressent pas dans l'onglet "Feuil1" manuellement
3) L'onglet "Bordereau" se complète automatiquement
4) Exporter les données conservées de l'onglet "Import" au format txt avec une macro
Le but étant de pouvoir envoyer le fichier txt modifié et le bordereau au format PDF.

Le fichier txt est généré à partir d'un logiciel métier. Sa structure est la suivante: un échantillon correspond à 5 lignes dans le fichier txt. Les lignes "DOS", "ECH", "LID" et "VID" gardent toujours la même structure, la ligne "ELE" est variable (Ligne "DOS": 5 champs non vides et 3 vides / Ligne "ECH" : 3 champs non vides et 6 vides / Ligne "ELE": variable de 1 à 190 champs non vides / Ligne "LID": 12 champs non vides / Ligne "VID": 5 champs non vides et 6 champs vides).

Etant débutant en vba, j'ai utilisé l'enregistreur de macro pour importer sur Excel les données du fichier txt --> OK
Le remplissage de l'onglet bordereau se fait à l'aide de fonctions sous Excel --> OK

Mon problème sur la dernière étape:
En parcourant le forum, j'ai utilisé une macro pour la conversion des données conservées de l'onglet "Feuil1" au format txt. Le souci, c'est que la macro génère pour chaque ligne autant de champs ";;" que la ligne comptant le plus de champs non vides.
Serait-il possible de m'aider à modifier la macro afin que le fichier txt généré ait des lignes ayant la même structure que le fichier txt de base?
D'avance merci

Cordialement

 

[Hasco]

Bonjour,

Dans votre macro de construction de ligne :

- Rajout d'une variable 'nb' pour recevoir le numéro de la dernière colonne occupée de la ligne en cours:

nb = Plage.Rows(I).Offset(, Plage.Columns.Count).End(xlToLeft).Column

- Légères modifications de la boucle
- Rajout d'une ligne de code pour enlever le ';' final de la ligne (à voir si vous voulez ou pas conserver)

J'ai testé la boucle de construction des lignes mais pas le reste.

Cordialement

 

[fanch55]

Bonsoir,
Sans préciser exactement dans le code ce que vous voulez à l'exportation,
le fichier ne sera pas vraiment identique à l'original.
Testez ce genre de code :

Sub ExporTxt()
Dim File    As Variant
Dim N       As Long
Dim Fso     As Object 'New FileSystemObject
Dim R       As Range
Dim Target  As Object 'TextStream
Dim Line    As Variant

    Set Fso = CreateObject("Scripting.FileSystemObject")
        File = "D:\........\Exporttxt.txt"
        Set Target = Fso.CreateTextFile(File)
        For Each R In UsedRange.Rows
            Select Case R.Cells(1)
                Case "DOS": N = 8 + 1
                Case "ECH": N = 9 + 1
                Case "LID": N = 12 + 1
                Case "VID": N = 11 + 1
                Case "ELE": N = Cells(R.Row, R.Columns.Count + 1).End(xlToLeft).Column
                Case Else: N = 0
            End Select
            If N > 0 Then
                Line = WorksheetFunction.Transpose(WorksheetFunction.Transpose(R.Cells(1).Resize(, N)))
                Line = Join(Line, ";")
                Target.Writeline Line
            End If
        Next
        Target.Close
        Set Target = Nothing
    Set Fso = Nothing

End Sub

 

[LLB29]

Bonjour,
Merci Hasco et Fanch55 pour votre rapidité dans votre réponse et vos propositions de modifications.

- Hasco, la macro modifiée ne permet pas de différencier les structures différentes de chacune des 5 lignes. Est-ce qu'il serait possible de créer une fonction
Ligne = Left(Ligne, Len(Ligne)-1) , modifiée en Ligne = Left(Ligne, Len(Ligne)) & ";;" par exemple pour la 1ère ligne
pour chacune des 5 lignes et de boucler sur l'ensemble du fichier ?

- Fanch55, je n'arrive pas à aller au bout de la macro car j'ai une erreur d'exécution 424 "Objet requis" pour la ligne:
For Each R In UsedRange.Rows
De ton code d'origine je n'ai juste modifié que le chemin d'accès du fichier
File = "D:\........\Exporttxt.txt" en File = "F:\Exporttxt.txt"
Je ne pense pas que cela doit l'impacter...

Je continue à étudier la problématique sur la base de vos codes. Si vous avez des propositions, je suis aussi preneur.

D'avance merci

 

[fanch55]

- Fanch55, je n'arrive pas à aller au bout de la macro car j'ai une erreur d'exécution 424 "Objet requis" pour la ligne:
For Each R In UsedRange.Rows

Exact, j'avais mis le code dans celui de la feuille concernée .
Si tu veux le mettre dans un module, prends celui-ci :

Sub ExporTxt()
Dim File    As Variant
Dim N       As Long
Dim Fso     As Object 'New FileSystemObject
Dim R       As Range
Dim Target  As Object 'TextStream
Dim Line    As Variant

    File = Application.GetSaveAsFilename(fileFilter:="Text Files,*.txt,Csv Files,*.csv", Title:="Export Text spécial")
    If File <> False Then
        Set Fso = CreateObject("Scripting.FileSystemObject")
            Set Target = Fso.CreateTextFile(File)
            For Each R In Worksheets("Feuil1").UsedRange.Rows
                Select Case R.Cells(1)
                    Case "DOS": N = 8 + 1
                    Case "ECH": N = 9 + 1
                    Case "LID": N = 12 + 1
                    Case "VID": N = 11 + 1
                    Case "ELE": N = R.Parent.Cells(R.Row, R.Columns.Count + 1).End(xlToLeft).Column
                    Case Else: N = 0
                End Select
                If N > 0 Then
                    Line = WorksheetFunction.Transpose(WorksheetFunction.Transpose(R.Cells(1).Resize(, N)))
                    Line = Join(Line, ";")
                    Target.Writeline Line
                End If
            Next
            Target.Close
            Set Target = Nothing
        Set Fso = Nothing
    End If

End Sub

 

[job75]

Bonjour LLB29, Hasco, fanch55,

Si je comprends bien vous voulez supprimer tous les points virgules inutiles en fin de ligne du fichier txt.

Donc dans la macro transfert_sous_traitance utilisez :

    'création du fichier txt'ou csv
    Chemin = Chemin & ".txt" 'ou ".csv"
    Open Chemin For Output As #1
    Dim x$
    For I = 1 To UBound(Tbl)
        x = Tbl(I)
        For J = Len(x) To 1 Step -1
            If Mid(x, J, 1) <> ";" Then Exit For
        Next J
        Print #1, Left(x, J)
    Next I
    Close #1

A+

 

[LLB29]

Bonjour,
Fanch55, tes modifications me permettent d'obtenir le résultat final attendu. Merci pour le temps pris pour cette résolution de problème!
Job75, le code rajouté à la macro d'origine permet effectivement de supprimer tous les ";" en bout de ligne, mais cela ne permet pas de différencier les structures différentes de chacune des 5 lignes.
Je vous remercie pour le temps pris et la rapidité de vos réponses.
Je valide la réponse de fanch55.
Merci

 

[job75]

Job75, le code rajouté à la macro d'origine permet effectivement de supprimer tous les ";" en bout de ligne, mais cela ne permet pas de différencier les structures différentes de chacune des 5 lignes.

Alors il suffit d'ajouter 3 points-virgules pour "DOS" et 2 points-virgules pour "ECH" :

    'création du fichier txt'ou csv
    Chemin = Chemin & ".txt" 'ou ".csv"
    Open Chemin For Output As #1
    Dim x$, y$
    For I = 1 To UBound(Tbl)
        x = Tbl(I)
        For J = Len(x) To 1 Step -1
            If Mid(x, J, 1) <> ";" Then Exit For
        Next J
        y = Left(x, 3)
        Print #1, Left(x, J) + IIf(y = "DOS", ";;;", IIf(y = "ECH", ";;", ""))
    Next I
    Close #1

 

[LLB29]

Bonsoir,

Merci pour ce retour, ces modifications et cette seconde solution!

Bonne soirée

 

[Mouelhib]

Bonsoir,
Sans préciser exactement dans le code ce que vous voulez à l'exportation,
le fichier ne sera pas vraiment identique à l'original.
Testez ce genre de code :

Sub ExporTxt()
Dim File    As Variant
Dim N       As Long
Dim Fso     As Object 'New FileSystemObject
Dim R       As Range
Dim Target  As Object 'TextStream
Dim Line    As Variant

    Set Fso = CreateObject("Scripting.FileSystemObject")
        File = "D:\........\Exporttxt.txt"
        Set Target = Fso.CreateTextFile(File)
        For Each R In UsedRange.Rows
            Select Case R.Cells(1)
                Case "DOS": N = 8 + 1
                Case "ECH": N = 9 + 1
                Case "LID": N = 12 + 1
                Case "VID": N = 11 + 1
                Case "ELE": N = Cells(R.Row, R.Columns.Count + 1).End(xlToLeft).Column
                Case Else: N = 0
            End Select
            If N > 0 Then
                Line = WorksheetFunction.Transpose(WorksheetFunction.Transpose(R.Cells(1).Resize(, N)))
                Line = Join(Line, ";")
                Target.Writeline Line
            End If
        Next
        Target.Close
        Set Target = Nothing
    Set Fso = Nothing

End Sub

Bonjour, prière de m'aider, je viens de tester votre macro seulement pour moi mon fichier comporte 40 colonnes avec autant de lignes qu'il faut et les colonnes concernent des champs provenant d'un logiciel métier qui a une certaine structure. Merci pour votre aide

 

[fanch55]

Bonjour, prière de m'aider, je viens de tester votre macro seulement pour moi mon fichier comporte 40 colonnes avec autant de lignes qu'il faut et les colonnes concernent des champs provenant d'un logiciel métier qui a une certaine structure. Merci pour votre aide

Bonjour,
Vous avez validé la réponse de @job75 ( bonjour @job75 ), je présume qu'en fait vous utilisez son code.
Je lui laisse le soin de répondre .
J'ai par ailleur examiné le nouveau classeur fourni, il me semble qu'il n'a rien à voir avec la demande ???

 

[Mouelhib]

Bonjour,
Vous avez validé la réponse de @job75 ( bonjour @job75 ), je présume qu'en fait vous utilisez son code.
Je lui laisse le soin de répondre .
J'ai par ailleur examiné le nouveau classeur fourni, il me semble qu'il n'a rien à voir avec la demande ???

mERCI pour votre réactivité, oui en fait je me bloque, j'ai besoin de convertir mon fichier excel que j'ai importé de Sage en fichier texte selon un modèle fourni (j'ai bien testé votre macro sur d'autres classeurs et elle marche seulement pour moi je doit remplacer les vides par des zéros par exemple si le code etablissement est sur 4 "1344" il doit être converti en '0000001344' et ainsi de suite. et merci pour votre aide.

 

[JHA]

Bonjour à tous,

Ci joint une solution power query dans l'onglet "Données" avec une copie des données en mode tableau de la "feuil1".
Solution avec format de nombre ou par formule dans l'onglet "fichier"

Edit: Désolé @fanch55 , je n'ai pas remarqué que le demandeur avait changé. Dommage, sous power query j'avais réussi à trouver pour les N° en texte à 10 caractères .

JHA

 

[fanch55]

mERCI pour votre réactivité, oui en fait je me bloque, j'ai besoin de convertir mon fichier excel que j'ai importé de Sage en fichier texte selon un modèle fourni (j'ai bien testé votre macro sur d'autres classeurs et elle marche seulement pour moi je doit remplacer les vides par des zéros par exemple si le code etablissement est sur 4 "1344" il doit être converti en '0000001344' et ainsi de suite. et merci pour votre aide.

Cette demande n'a rien à voir avec ce post, vous devriez créer votre propre discussion .
Votre problème semble concerner une importation plutôt qu'une exportation ..

 

[Mouelhib]

Bonjour à tous,

Ci joint une solution power query dans l'onglet "Données" avec une copie des données en mode tableau de la "feuil1".
Solution avec format de nombre ou par formule dans l'onglet "fichier"

Edit: Désolé @fanch55 , je n'ai pas remarqué que le demandeur avait changé. Dommage, sous power query j'avais réussi à trouver pour les N° en texte à 10 caractères .

JHA

Merci beaucoup