Convertir excel en txt avec le caractère |

––––––––––––––––––––––––––––––––––––––––––––
| Prénom     | Nom       | Sexe | Né_le    |
––––––––––––––––––––––––––––––––––––––––––––
| Rodolphe   | Philippe  | M    | 25/12/57 |
| Christiane | Françoise | F    | 13/01/45 |
| Frédéric   |           | M    | 05/10/69 |
––––––––––––––––––––––––––––––––––––––––––––

Option Explicit
Option Private Module
Public Sub EnregistrerPseudoTableau()
' Enregistre la feuille 1 comme un tableau lisible avec un éditeur de texte.
'
Dim z As Range                    'Zone
Dim r As Range                    'Ligne
Dim c As Range                    'Cellule
Dim t() As Long                   'Tableau largeur de colonne
Dim nomComplet As String          'Nom complet du fichier
Dim str As String                 'Texte du fichier
Dim nbc As Long                   'Nombre de caractères du champ
Dim lgr As Long                   'Longueur du tableau
Dim lgn As String                 'Caractère pour ligne
Const sep As String = " |"        'Séparateur de champs

  lgn = Chr(150)  ' tiret semi-cadratin 'ou Chr(151) tiret cadratin
  With ThisWorkbook
    nomComplet = .Path & "\Fichiers texte\Test xls vers texte ANSI pseudo-tableau.txt"  'à adapter au besoin
    With Worksheets(1)
      Set z = .Range("A1").CurrentRegion  'Tableau à exporter (à adapter)
      ' 1° passe : recherche de la longueur de chaque colonne
      ReDim t(1 To z.Columns.Count)
      For Each r In z.Rows
        For Each c In r.Cells
          nbc = Len(c.Text)
          If nbc > t(c.Column) Then t(c.Column) = nbc
        Next c
      Next r
      ' 2° passe : longueur d'une ligne du tableau
      For Each c In z.Rows(1).Cells
        lgr = lgr + t(c.Column) + 3
      Next c
      lgr = lgr + 1
      ' 3° passe : création du pseudo-tableau
      ' - première ligne
      str = String(lgr, lgn) & vbCrLf
      ' - autres lignes
      For Each r In z.Rows
        str = str & "|"
        For Each c In r.Cells
          nbc = Len(c.Text)
          str = str & " " & c.Text & String(t(c.Column) - nbc, " ") & sep
        Next c
        str = str & vbCrLf
        If r.Row = 1 Then
          ' - ligne de séparation des titres
          str = str & String(lgr, lgn) & vbCrLf
        End If
      Next r
      ' - dernière ligne+
      str = str & String(lgr, lgn) & vbCrLf
    End With
    If Not EstEcritTexte(str, nomComplet) Then
      MsgBox "L'écriture de « " & .Name & " » a échoué."
    End If
  End With

End Sub

Private Function EstEcritTexte(texteASCII As String, nomCompletFichier As String) As Boolean
' Effectivité de l'écriture d'un fichier binaire sous forme de texte (caractères ASCII).
'
Dim n°F As Integer                'numéro du fichier
Dim rèp As Integer                'réponse MsgBox
  
  If Dir(nomCompletFichier) <> "" Then
    If MsgBox("Le fichier " & nomCompletFichier & " existe déjà." & vbCr & vbCr & _
              "Voulez-vous l'écraser ? ", vbExclamation + vbYesNo + vbDefaultButton2) _
              <> vbYes Then Exit Function
    Kill nomCompletFichier
  End If
  n°F = FreeFile
  On Error Resume Next
  Open nomCompletFichier For Binary Access Write As #n°F
  Put #n°F, , texteASCII
  EstEcritTexte = True
  Close #n°F
  On Error GoTo 0

End Function