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