Forcer un enregistrement au format CSV séparé par point-virgule

Bonjour à tous

J'ai développé une macro qui permet d'enregistrer une table au format CSV séparée par des point-virgule. Ce fichier a pour but d'être intégré dans un outil dans lequel les séparateurs sont configurés d'une manière précise (";" pour séparateur de liste, "." pour les décimales et "," pour les milliers). Celle-ci fonctionne très bien lorsque les paramètres de séparateurs de liste sur Windows sont configurés pour être un point-virgule.

Cependant, nous avons des utilisateurs anglais qui risquent d'avoir ce paramètre réglé sur une virgule. J'ai donc changé mes paramètres windows pour faire le test, et ma macro enregistre donc le fichier CSV avec comme séparateur une virgule. J'ai essayé d'enlever le paramètre "Local:=True" mais cela ne change rien.

Savez-vous si il est possible de forcer le séparateur point-virgule peu importe les paramètres windows ? J'ai déjà forcé les séparateurs de milliers et décimales car ce sont des paramètres que l'on peut régler dans Excel, mais pour les séparateurs de liste, c'est différent car c'est un paramètre Windows.

Pour info, voici ma macro :

Sub xlsToCSV()

    Dim currentCell As Variant
    Dim Path As String
    Dim FileName As String
    Dim UseSystemSeparators As Boolean
    Dim DecimalSeparator As String
    Dim ThousandsSeparator As String
    Dim Dialog As FileDialog
    Dim FiltersCount, Index As Integer
    On Error GoTo errHandler

    Application.ScreenUpdating = False

    'Current cell
    currentCell = ActiveCell.Address

    'Copy to new sheet
    Range("A2", "E" & calculateLastRowIndex("B", "C", "D", "E")).Select
    Selection.Copy
    Range(currentCell).Select
    Workbooks.Add
    ActiveSheet.Paste
    ActiveSheet.Cells(1, 1).Select
    Application.CutCopyMode = False
    Application.DisplayAlerts = 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 = ","

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

    For FiltersCount = 1 To Dialog.Filters.Count
        If Dialog.Filters(FiltersCount).Extensions = "*.csv" 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:=xlCSV, 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

errHandler:

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

    Application.ScreenUpdating = True
End Sub

Merci d'avance !

Caroline

Rebonjour,

J'ai finalement trouvé une solution et je me suis dit que j'allais la partager, peut-être que cela pourra en aider certain.e.s

Le seul moyen que j'ai trouvé pour forcer le séparateur de liste est de créer le fichier CSV moi-même. Pour cela je prend ma table où il y a les données, et j'itère dessus ligne par ligne pour fusionner tous les éléments de la ligne dans une même cellule en ajoutant un point-virgule entre chaque élément.

Pour ne pas "écraser" ma table de données en concaténant tout dans la première colonne, j'ouvre un nouveau workbook dans lequel j'écris le résultat concaténé.

Enfin j'enregistre ce nouveau workbook au format CSV.

Je ne sais pas si c'est la manière la plus propre de le faire, mais ça fonctionne ! Voici le nouveau code (avec le fichier de données test => il faut donc adapter les indices max d'itération en fonction du nombre de colonnes et de lignes) :

Sub xlsToCSV()

    Dim Path As String
    Dim FileName As String
    Dim UseSystemSeparators As Boolean
    Dim DecimalSeparator As String
    Dim ThousandsSeparator As String
    Dim Dialog As FileDialog
    Dim FiltersCount, Index As Integer

    Dim i As Integer, j As Integer, concatenateData As String

    Workbooks.Add

    For i = 1 To 5

        For j = 1 To 3

            concatenateData = concatenateData & Workbooks("test_fusion_colonne.xlsx").Worksheets("Sheet1").Cells(i, j) & ";"

        Next

        ActiveWorkbook.ActiveSheet.Cells(i, 1) = concatenateData & Workbooks("test_fusion_colonne.xlsx").Worksheets("Sheet1").Cells(i, 4)
        concatenateData = Empty

    Next

    Application.DisplayAlerts = 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 = ","

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

    For FiltersCount = 1 To Dialog.Filters.Count
        If Dialog.Filters(FiltersCount).Extensions = "*.csv" 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:=xlCSV, 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

End Sub

Bonne journée

Caroline