Problème de séparateurs de liste, milliers et décimales

Bonjour à tous

J'ai développé une macro qui a pour but d'enregistrer la table de données (colonnes A à E) au format CSV. Le principe est que pour chaque ligne, j'itère sur chaque élément pour les concaténer (avec comme séparateur un point-virgule) dans un nouveau workbook que j'enregistre puis je ferme (cf macro complète à la fin de mon poste).

Ayant des users un peu partout dans le monde, le paramétrage des séparateurs peut varier, et le but est que cette macro force le format suivant :

- Séparateur de liste = point-virgule
- Séparateur de milliers = rien ou virgule
- Séparateur de décimales = point

J'ai cependant rencontré plusieurs soucis (cf mon ancien poste = > https://forum.excel-pratique.com/excel/forcer-un-enregistrement-au-format-csv-separe-par-point-virgu...) :

- Le format CSV avec point virgule fonctionne bien si le paramètre système Windows est réglé sur un point-virgule, mais si c'est une virgule, impossible de changer avec la fonction SaveAs => j'ai donc créer mon CSV à la main en concaténant les éléments séparés par des point-virgules dans une même colonne. Sauf qu'en enregistrant en CSV cette colonne, des guillemets se mettent automatiquement autour de chaque ligne et impossible de les retirer.
La seule méthode que j'ai trouvé pour contourner le problème est d'enregistrer au format texte, avec le paramètre FileFormat:=xlTextPrinter. Si vous avez des idées sur la raison de ce problème je suis toute ouïe (norme ASCII ?) !

For FiltersCount = 1 To Dialog.Filters.Count
        If Dialog.Filters(FiltersCount).Extensions = "*.txt" Then
            Index = FiltersCount
            Exit For
        End If
    Next

    With Dialog
        .FilterIndex = Index
        .Title = "Enregistrer sous... / Save as..."
        .Show

        If .SelectedItems.Count > 0 Then
            Path = .SelectedItems(1)
            ActiveWorkbook.SaveAs FileName:=Path, FileFormat:=xlTextPrinter, CreateBackup:=False, Local:=True

        Else
            MsgBox "Aucun emplacement ou nom n'a été défini. Merci de réessayer!" & Chr(10) & _
                                                                                            "No location or name has been defined. Please retry!"
        End If
    End With

- Mon deuxième problème concerne les séparateurs de décimales et milliers. L'idée qui semble sur le papier marcher est de changer le paramétrage de l'utilisateur pour mettre les paramètres que je souhaite ( "." = décimales et "," = milliers).

'Save current separator parameters
 UseSystemSeparators = Application.UseSystemSeparators
 DecimalSeparator = Application.DecimalSeparator
 ThousandsSeparator = Application.ThousandsSeparator

 'Save separator parameters required by Data Management
 Application.UseSystemSeparators = False
 Application.DecimalSeparator = "."
 Application.ThousandsSeparator = ","

- Le problème est que si ma donnée est un nombre décimal, au moment où je la recopie dans le nouveau workbook, même si le paramétrage de la décimale est en point a été forcé, le point redevient une virgule. Mon idée était donc de faire un rechercher/remplacer des virgules en point. Mais c'est là où ça devient casse-tête : selon le paramétrage de l'utilisateur cela rentre en conflit avec le séparateur des milliers. Je ne comprends pas pourquoi le point se transforme en virgule et le seul moyen que j'ai trouvé pour contourner ce problème est de changer le séparateur des milliers par un "/" pour être sûre qu'il n'y ait aucun conflit... mais bon c'est pas très joli et très bancal je trouve. Si quelqu'un a la moindre piste, je suis preneuse !

Enfin, pour apporter plus de détails, voici ma macro complète et en pièce jointe un jeu de données test :

Sub xlsToCSV()

    Dim Path As String
    Dim FileName As String
    Dim UseSystemSeparators As Boolean
    Dim DecimalSeparator As String
    Dim ThousandsSeparator As String
    Dim lastDataRowIndex As Long
    Dim Dialog As FileDialog
    Dim FiltersCount, Index As Integer
    Dim i As Integer, j As Integer, mergedData As String
    On Error GoTo errHandler

    Application.ScreenUpdating = False

    'Save current separator parameters
    UseSystemSeparators = Application.UseSystemSeparators
    DecimalSeparator = Application.DecimalSeparator
    ThousandsSeparator = Application.ThousandsSeparator

    'Save separator parameters required by Data Management
    Application.UseSystemSeparators = False
    Application.DecimalSeparator = "."
    Application.ThousandsSeparator = "/"

    lastDataRowIndex = calculateLastRowIndex("B", "C", "D", "E")

    Workbooks.Add

    For i = 2 To lastDataRowIndex

        For j = 1 To 4

            mergedData = mergedData & ThisWorkbook.Worksheets("Data").Cells(i, j) & ";"

        Next
        ActiveWorkbook.ActiveSheet.Cells(i - 1, 1) = mergedData & ThisWorkbook.Worksheets("Data").Cells(i, 5)

        ActiveWorkbook.ActiveSheet.Cells(i - 1, 1) = Replace(ActiveWorkbook.ActiveSheet.Cells(i - 1, 1), "/", "")
        ActiveWorkbook.ActiveSheet.Cells(i - 1, 1) = Replace(ActiveWorkbook.ActiveSheet.Cells(i - 1, 1), ",", ".")

        mergedData = Empty

    Next

    Application.DisplayAlerts = False

    'Save dialog / file forced as CSV
    Set Dialog = Application.FileDialog(msoFileDialogSaveAs)

    For FiltersCount = 1 To Dialog.Filters.Count
        If Dialog.Filters(FiltersCount).Extensions = "*.txt" Then
            Index = FiltersCount
            Exit For
        End If
    Next

    With Dialog
        .FilterIndex = Index
        .Title = "Enregistrer sous... / Save as..."
        .Show

        If .SelectedItems.Count > 0 Then
            Path = .SelectedItems(1)
            ActiveWorkbook.SaveAs FileName:=Path, FileFormat:=xlTextPrinter, CreateBackup:=False, Local:=True

        Else
            MsgBox "Aucun emplacement ou nom n'a été défini. Merci de réessayer!" & Chr(10) & _
                                                                                            "No location or name has been defined. Please retry!"
        End If
    End With

    ActiveWorkbook.Close

errHandler:

    'Restore current separator parameters
    Application.UseSystemSeparators = UseSystemSeparators
    Application.DecimalSeparator = DecimalSeparator
    Application.ThousandsSeparator = ThousandsSeparator

    Application.ScreenUpdating = True
End Sub

Merci d'avance à ceux qui ont eu le courage de tout lire et bonne journée

Caroline

Bonjour

Pas sûr ce cela soit la bonne réponse mais à tester.

Sub EcrireCsv()
  Dim ligne$
  Dim rng As Range
  Dim i!, j%
  Dim fnum%, myFile$

  myFile = ActiveWorkbook.Path & "\test01.csv"
  fnum = FreeFile()
  Open myFile For Append As #fnum

  Set rng = Sheets("Sheet1").Range("A2").CurrentRegion
  For i = 1 To rng.Rows.Count
    ligne = ""
    For j = 1 To rng.Columns.Count
      ligne = ligne & Replace(rng.Cells(i, j).Value2, ",", ".") & ";"
    Next j
    ligne = Left(ligne, Len(ligne) - 1)
    Print #fnum, ligne
  Next i
  Close #fnum

End Sub