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

12classeur1.xlsx (31.31 Ko)

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 :

17css.xlsm (43.21 Ko)

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

image

5- Choisir l'emplacement de l'enregistrement du fichier sur le bureau

6- Enregistrer

image

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.

15css.xlsm (44.23 Ko)

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.

12csv.xlsm (44.29 Ko)

Il y a toujours une modification de la mise en page.

Voici le format après l'export :

image

Le format que j'aurais besoin :

image

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 Function

Si ç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.

Rechercher des sujets similaires à "exporter feuille cvs renommer automatiquement"