XL 2016 Transformation .xlsx vers .txt avec conditions

[mactoche]

Bonjour à tous

Je cherche à enregistrer mon : "fichier source.xlsx" tout comme le "fichier cible.txt"
Evidement il y a une condition d'affichage, celle de mettre des espaces à la place des colonnes.

les fichiers en PJ

Merci d'avance

 

[job75]

Bonsoir mactoche,

Il suffit de regarder : le fichier txt n'a rien à voir avec le fichier xlsx...

A+

 

[mactoche]

Bonsoir mactoche,

Il suffit de regarder : le fichier txt n'a rien à voir avec le fichier xlsx...

A+

Oui effectivement lol, les 2 fichiers sont différents, se sont des exemples de fichiers source vers cible. C'était pour montrer les colonnes qui prennent place pour des espaces.

 

[job75]

Oui effectivement lol, les 2 fichiers sont différents

lol en attendant la soupe va refroidir donc débrouillez-vous.

 

[fanch55]

Bonsoir,
Testez le code ci-dessous,
le fichier txt a des formats que je n'appréhende pas complètement,
j'ai essayé de m'y coller au plus près :

Sub Exportxt()

Dim FSO     As Object 'New FileSystemObject
Dim R       As Range
Dim C       As Range
Dim Target  As Object 'TextStream
Dim W       As String

    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FileToOpen <> False Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
            Set Target = FSO.CreateTextFile(FileToOpen)
                For Each R In Range("A1:W19").Rows
                    For Each C In R.Cells
                        Select Case C.Column
                        Case 1:  W = C.Text
                        Case 11:
                            If C = "" Then W = W & " " & String(8, " ") _
                                      Else W = W & " " & Right(String(8, "0") & C, 8)
                        Case Else: W = W & " " & C.Text
                        End Select
                    Next
                    Target.writeline W
                Next
            Target.Close
            Set Target = Nothing
        Set FSO = Nothing
    End If

End Sub

 

[mactoche]

Bonsoir,
Testez le code ci-dessous,
le fichier txt a des formats que je n'appréhende pas complètement,
j'ai essayé de m'y coller au plus près :

Sub Exportxt()

Dim FSO     As Object 'New FileSystemObject
Dim R       As Range
Dim C       As Range
Dim Target  As Object 'TextStream
Dim W       As String

    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FileToOpen <> False Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
            Set Target = FSO.CreateTextFile(FileToOpen)
                For Each R In Range("A1:W19").Rows
                    For Each C In R.Cells
                        Select Case C.Column
                        Case 1:  W = C.Text
                        Case 11:
                            If C = "" Then W = W & " " & String(8, " ") _
                                      Else W = W & " " & Right(String(8, "0") & C, 8)
                        Case Else: W = W & " " & C.Text
                        End Select
                    Next
                    Target.writeline W
                Next
            Target.Close
            Set Target = Nothing
        Set FSO = Nothing
    End If

End Sub

Merci ça à l'air de bien fonctionner.
Y a t-il moyen de rajouter un code pour enregistrer le fichier cible en .txt sans désigner un fichier mais en faisant un enregistrement au nom du .xlsx ?

Merci
Christophe

 

[fanch55]

Sub Exportxt()
Dim File    As Variant
Dim Fso     As Object 'New FileSystemObject
Dim R       As Range
Dim C       As Range
Dim Target  As Object 'TextStream
Dim Line    As String

'    File = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    File = Split(ThisWorkbook.FullName, ".")
    File(UBound(File)) = "txt"
    File = Join(File, ".")
    If File <> False Then
        Set Fso = CreateObject("Scripting.FileSystemObject")
            Set Target = Fso.CreateTextFile(File)
                For Each R In Range("A1:W19").Rows
                    For Each C In R.Cells
                        Select Case C.Column
                        Case 1:  Line = C.Text
                        Case 11: ' Valeur sur 8 positions
                            Line = Line & " " & _
                                IIf(C = "", String(8, " "), Right(String(8, "0") & C, 8))
                         Case Else: Line = Line & " " & C.Text
                        End Select
                    Next
                    Target.writeline Line
                Next
            Target.Close
            Set Target = Nothing
        Set Fso = Nothing
    End If

End Sub