Amélioration d'une macro VBA qui change convertit une feuille Excel en CSV

Bonjour, déjà voici mon code, il permet de transformer la feuille Excel en fichier CSV

Sub ExportCSV()
  Dim nomFichier As String
  Dim chemin As String

  chemin = ThisWorkbook.Path & "\"
  nomFichier = chemin & "test.csv"

  ThisWorkbook.Worksheets("Deliveries").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=nomFichier, FileFormat:=xlCSV, local:=True
  ActiveWorkbook.Close
  Application.DisplayAlerts = True

  Dim sInFilePath As String
  Dim sOutFilePath As String

   sInFilePath = nomFichier
   sOutFilePath = nomFichier

  Call WriteANSItoUF8WithoutBOM(sInFilePath, sOutFilePath)
End Sub

Mais j'ai besoin de l'améliorer, déjà tout d'abord je voudrais changer le séparateur qui est un ";" en ";!@#;" pour lever toute ambiguité, ainsi qu'un MsgBox qui indique combien de lignes du Excel ont été convertis en CSV, j'ai cette petite partie de code, mais je ne sais pas comment l'implanter dans la macro principale

With ActiveSheet
            'Number of rows to export is based on the contents
            'of column J. If it should be based on a different
            'column, change the following line to reflect the
            'column desired.
            Rows = .Cells(.Rows.Count, "J").End(xlUp).Row
            For J = 1 To Rows
                sTemp = ""
                Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
                For K = 1 To Cols
                    sTemp = sTemp & .Cells(J, K).Value
                    If K < Cols Then sTemp = sTemp & sSep
                Next
                Print #1, sTemp
            Next J
        End With

        Close 1
        sTemp = "There were " & Rows & " rows of data written "c

Comment faire ? Merci d'avance de votre aide

en vrai plus simplement, comment changer le séparateur du fichier de sortie CSV pour que ce soit celui que je veux ?

Bonjour

Sauf que le format csv correspond à une norme et donc à ce moment là ce ne sera plus un fichier .csv mais un format exotique.

Oui mais j'ai un programme qui marchait pour un fichier à choisir, là je veux pareil sauf que je veux sur une feuille d'un Excel, sur le fichier ça donnait ça, qui marchait

Sub Main()
    Dim fileToConvertInCSV As String
    Dim fileToConvertInUTF8 As String
    Dim Result

    Do Until Result = vbNo

        fileToConvertInCSV = FileSelected
        fileToConvertInUTF8 = CSVConverted(fileToConvertInCSV)
        Call WriteANSItoUF8WithoutBOM(fileToConvertInUTF8, fileToConvertInUTF8)
        Result = MsgBox("Do you want to select another file ?", vbQuestion + vbYesNo)
    Loop

    'améliorations à implémenter
    'File Selected => n'autoriser que la sélection Excel
    'ConvertUTF8 => convertir en UTF8 sans N
End Sub

Function FileSelected() As String
    'Function to Open a file

    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
       .Filters.Clear
       .Filters.Add "Excel Files", "*.xlsx?,*.xls?,*.xlsb?,*.xlsm?", 1
       .Title = "Choose an Excel file"
       .AllowMultiSelect = False

       If .Show = True Then
           FileSelected = .SelectedItems(1)
       End If
    End With

End Function

Function CSVConverted(fileToConvert As String) As String

    Dim toConvertFile As String
    Dim convertedFile As String
    Dim Rows As Long
    Dim Cols As Long
    Dim J As Long
    Dim K As Long
    Dim sTemp As String
    Dim sSep As String
    Dim wb As Workbook

    Const adCrLf                As Long = -1
    Const adModeUnknown         As Long = 0
    Const adSaveCreateOverWrite As Long = 2
    Const adTypeText            As Long = 2

    sSep = ";!@#;" 'Specify the separator to be used

    toConvertFile = fileToConvert

    Workbooks.Open toConvertFile
    Sheets(1).Activate

    Dim fileExtension As String
    fileExtension = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "."))

    If fileExtension = "xlsm" Or fileExtension = "xlsx" Or fileExtension = ".xlsb" Or fileExtension = ".xls" Then

        toConvertFile = Mid(toConvertFile, 1, Len(toConvertFile) - Len(fileExtension))
        convertedFile = toConvertFile & ".csv"
        Open convertedFile For Output As 1

        With ActiveSheet
            'Number of rows to export is based on the contents
            'of column J. If it should be based on a different
            'column, change the following line to reflect the
            'column desired.
            Rows = .Cells(.Rows.Count, "J").End(xlUp).Row
            For J = 1 To Rows
                sTemp = ""
                Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
                For K = 1 To Cols
                    sTemp = sTemp & .Cells(J, K).Value
                    If K < Cols Then sTemp = sTemp & sSep
                Next
                Print #1, sTemp
            Next J
        End With

        Close 1

        sTemp = "There were " & Rows & " rows of data written "
        sTemp = sTemp & "to this file:" & vbCrLf & toConvertFile
    Else
        sTemp = "This macro needs to be run on a workbook "
        sTemp = sTemp & "stored in the XLSX, XLSM, XLSB or XLS format."
    End If

    ActiveWorkbook.Close

    'Dim wbName As String
    'wbName = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "\"))

    'For Each wb In Workbooks
    '    If wb.Name = wbName Then
    '        Workbooks.Close wbName
    '        Exit Sub
    '    End If
    'Next

    MsgBox sTemp

    CSVConverted = convertedFile

End Function

Sauf que là, j'ai les données une feuille d'un fichier, et j'ai le bouton de la macro dans l'autre feuille, et je veux en appuyant sur le bouton que l'autre feuille se transforme en fichier CSV (ou exotique je sais pas, mais comme sur le code au dessus) avec le bon délimiteur

Rechercher des sujets similaires à "amelioration macro vba qui change convertit feuille csv"