XL 2016 Transformation .xlsx vers .txt avec conditions

mactoche

XLDnaute Nouveau
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
 

Pièces jointes

  • Fichier cible.txt
    604 bytes · Affichages: 14
  • Fichier origine.xlsx
    8.8 KB · Affichages: 10

fanch55

XLDnaute Accro
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 :
VB:
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

XLDnaute Nouveau
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 :
VB:
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

XLDnaute Accro
VB:
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
 

Discussions similaires

Réponses
73
Affichages
1 K
Réponses
1
Affichages
355
Réponses
8
Affichages
393

Statistiques des forums

Discussions
291 730
Messages
1 917 540
Membres
179 714
dernier inscrit
saiter
Haut Bas