Exporter une feuille en .CVS et renommer automatiquement
Bonjour à tous,
J'ai réalisé cette manipulation en manuel et je voudrais la rendre automatique :
- Enregistrer sous la feuille "Format SI ODO" en "CVS UTF-8 (délimité par des virgules)(*.cvs)"
- Et en la renommant : MG_SNCF_VR_2.0Test--------SNCF 2.0test--------"=Format SI ODO E2"-0_"Format SI ODO S2"_"Format SI ODO T2"_0010190
La feuille "Format SI ODO" est rempli de calcul, mais il me faut que ce soit les valeurs qui sont exportés et non la formule de calcul.
J'espère avoir été clair sur la demande.
Merci d'avance
Pige pas ce que vous entendez par
- Et en la renommant : MG_SNCF_VR_2.0Test--------SNCF 2.0test--------"=Format SI ODO E2"-0_"Format SI ODO S2"_"Format SI ODO T2"_0010190
S'il s'agit d'une exportation simple vous pouvez tester ceci :
J'ai essayé de lancé la macro, mais j'ai une erreur d'exécution 52.
Pour le chemin d'accès pourvez vous mettre le bureau.
Pour la partie que vous n'avez pas compris, le nom du fichier excel qui est exporté doit être renommé :
MG_SNCF_VR_2.0Test--------SNCF 2.0test--------"Format SI ODO E2"-0_"Format SI ODO S2"_"Format SI ODO T2"_0010190
Valeur de la case E2
Valeur de la case S2
Valeur de la case T2
Ce fichier va être exporté sur une base informatique et le nom du fichier à une très grande importance, sinon l'export ne pourra pas ce faire.
J'espère avoir été plus clair sur ma demande
Je préfère laisser tomber car je n'ai toujours rien compris à votre besoin. Bonne chance.
En manuel :
1- Sélectionner la feuille qui se nomme Format SI ODO
2- Enregistrer sous
3- Format du fichier à enregistrer : CVS UTF-8 (délimité par des virgules)(*.cvs)
4- Renommer le fichier : MG_SNCF_VR_2.0Test--------SNCF 2.0test--------285-0_20231207_152633_0010190
Dont la ressource des nombres :
- 285 se trouve dans la feuille FORMAT SI ODO en case E2
- 20231207 se trouve dans la feuille FORMAT SI ODO en case S2
- 152633 se trouve dans la feuille FORMAT SI ODO en case T2
5- Choisir l'emplacement de l'enregistrement du fichier sur le bureau
6- Enregistrer
J'explique toutes les états que je réalise en manuel, est-ce possible de le réaliser en vba ?
Merci d'avance
Essayez ceci, mais la sauvegarde des lignes 1 à 133 dans un fichier CSS ne sera valide que si le n° du véhicule et le groupe date-heure sont constants dans les colonnes E2, S2 et T2.
Je viens de me rendre compte que ce n'est pas un fichier en .CSS mais en .CSV qu'il me faut.
J'ai donc modifier le .CSS en .CSV dans toute la macro.
J'ai lancé l'extraction et la mise en forme change, mais il ne faut pas que celle-ci soit modifiée sur le fichier exporté.
J'ai ajouté deux fichiers :
- l'un vient de la macro
- l'autre est le résultat que je voudrais obtenir
Sub Sauvegarde()
Dim wS As Worksheet, i As Integer, j As Long
Dim chemin As String, sep As String, ligne As String, ficCsv As String
Dim numVh As String, dateOps As String, heureOps As String
sep = Chr(44) ' Virgule
chemin = ThisWorkbook.Path & "\"
Set wS = Sheets("Format SI ODO")
numVh = wS.Range("E2")
dateOps = Format(wS.Range("S2"), "yyyymmdd")
heureOps = Format(wS.Range("T2"), "hhmmss")
ficCsv = chemin & "MG_SNCF_VR_2.0Test--------SNCF 2.0test--------" & numVh _
& "-0_" & dateOps _
& "_" & heureOps _
& "_0010190.csv"
Open ficCsv For Output As #1
ligne = ""
For j = 1 To wS.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To 22
ligne = ligne & wS.Cells(j, i) & sep
Next i
ligne = Left(ligne, Len(ligne))
Print #1, j, ligne
Next j
Close #1
MsgBox "Fichier enregistré."
End Sub
Ce n'est pas votre faute, c'est moi qui me suis pris les pieds dans le tapis.
C'est vous qui avez voulu utiliser la virgule comme séparateur. Vous allez dans la macro et vous remplacez Chr(44) par Chr(59).
Sub ExportCSVWithFormat2()
Dim ws As Worksheet
Dim newFileName As Variant
Dim nomClient As String
Dim dateCommande As String
Dim autreDonnee As String
Dim exportCanceled As Boolean ' Variable pour vérifier si l'exportation a été annulée
Dim fileContent As String
Dim RowIndex As Long
Dim ColIndex As Long
' Spécifiez la feuille que vous souhaitez exporter
Set ws = ThisWorkbook.Sheets("Feuille 1")
' Récupérer les données des cellules pour inclure dans le nom du fichier
nomClient = ws.Range("E2").Value ' Par exemple, si le nom du client est dans la cellule E2
dateCommande = Format(ws.Range("S2").Value, "YYYYMMDD") ' Formatage de la date de commande au format YYYYMMDD
autreDonnee = Format(ws.Range("T2").Value, "HHMMSS") ' Autre donnée
' Demander à l'utilisateur où enregistrer le fichier CSV avec les données spécifiques incluses dans le nom du fichier
newFileName = Application.GetSaveAsFilename(InitialFileName:="Indiquer le nom du fichier" & nomClient & "-0_" & dateCommande & "_" & autreDonnee & "_002" & ".csv", FileFilter:="Fichiers CSV (*.csv), *.csv")
If newFileName = False Then
' Si l'utilisateur annule l'enregistrement, quitter la macro
MsgBox "Exportation annulée"
Exit Sub
End If
If IsFileOpen(newFileName) Then
' Si le fichier est ouvert, avertir l'utilisateur que l'exportation est annulée
MsgBox "Le fichier que vous essayez d'exporter est ouvert. Veuillez le fermer puis refaire l'exportation.", vbExclamation
Exit Sub
End If
' Vérifier si le fichier existe déjà
If Dir(newFileName) <> "" Then
' Si le fichier existe, demander confirmation pour le remplacer
If Not ConfirmReplaceFile(newFileName) Then
' Si l'utilisateur choisit de ne pas remplacer, marquer l'exportation comme annulée
MsgBox "Exportation annulée"
Exit Sub
End If
' Supprimer le fichier existant
Kill newFileName
End If
' Parcourir chaque ligne de la feuille
For RowIndex = 1 To ws.UsedRange.Rows.Count
' Réinitialiser la ligne de données
Dim rowData As String
rowData = ""
' Parcourir chaque cellule de la ligne
For ColIndex = 1 To ws.UsedRange.Columns.Count
' Ajouter la valeur de la cellule à la ligne de données
rowData = rowData & ws.Cells(RowIndex, ColIndex).Text & ";"
Next ColIndex
' Supprimer le dernier point-virgule de la ligne de données
rowData = Left(rowData, Len(rowData) - 1)
' Ajouter la ligne de données au contenu du fichier
fileContent = fileContent & rowData & vbCrLf
Next RowIndex
' Écrire le contenu du fichier dans un fichier temporaire avec l'encodage UTF-8
Dim tempFileName As String
tempFileName = Environ$("temp") & "\" & "temp_export.csv"
With CreateObject("ADODB.Stream")
.Type = 2 ' Text
.Charset = "utf-8"
.Open
.WriteText fileContent
.SaveToFile tempFileName, 2 ' Save as UTF-8
.Close
End With
' Si l'exportation n'a pas été annulée, renommer le fichier temporaire avec le nom souhaité
On Error Resume Next
Name tempFileName As newFileName
On Error GoTo 0
MsgBox "Exportation terminée"
End Sub
Function ConfirmReplaceFile(ByVal filename As String) As Boolean
' Demande de confirmation pour remplacer le fichier existant
Dim confirmResult As VbMsgBoxResult
confirmResult = MsgBox("Le fichier existe déjà. Voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Fichier existant")
ConfirmReplaceFile = (confirmResult = vbYes)
End Function
Function IsFileOpen(ByVal filename As String) As Boolean
' Vérifie si le fichier est ouvert
Dim filenum As Integer
Dim errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
Select Case errnum
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error errnum
End Select
On Error GoTo 0
End FunctionSi ça peux intéresser des personnes, voici le code qui exporte la "Feuille 1" et l'enregistre en format CVS UTF-8 (délimité pas des virgules) sans modifier l'état de la feuille 1 et la renomme automatiquement.

