Procédure de sauvegarde avec vba

Fermé

LinDouch42 - Modifié le 19 déc. 2020 à 15:55
ptitpanda Messages postés 65 Date d'inscription dimanche 5 août 2012 Statut Membre Dernière intervention 8 avril 2023 - 19 déc. 2020 à 15:55

Bonjour,

J'ai une procédure de sauvegarde dans une macro et je souhaiterai rajouter la création d'un sous dossier supplémentaire.
Cette procédure me donne une possibilité d'ajouter un sous dossier année s'il n'existe pas et je voudrais rajouter un autre sous dossier mois, certainement en utilisant Format([F1], "mmmm", pour que le fichier soit rangé dans le dossier Facture \AnnexeFactures\"Année"\"mois"

Merci pour votre aide

' Procédure de sauvegarde du nouveau Classeur -----------------------------------
    Application.DisplayAlerts = False ' Désactive la confirmation de remplacement
    On Error Resume Next
        'Dossier = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\"
        Dossier = ThisWorkbook.Path & "\..\Factures\AnnexeFactures\"
        ' On ajoute le sous-dossier année
        FileName = Dossier & Format([F1], "yyyy")
        ' On le crée s'il n'existe pas
        If Dir(FileName, vbDirectory) = "" Then MkDir FileName
        
        'FileName = FileName & "\" & "Annexe_1_Détail_Prestations_Spéciales_Facture_Mois_" & Format([F1], "mmm_yyyy")
        
        FileName = FileName & "\" & "Annexe 2 - Facture " & Format([F1], "mmmm yyyy") & " - Récap prestations spéciales - Ciblex Mions"
        
       
        ' On va tenter de sauvegarder le nouveau Classeur avec le nom prévu
        ActiveWorkbook.SaveAs FileName:=FileName
        If Err > 0 Then
            ' le dossier n'existant probablement pas,
            ' l'utilisateur doit en choisir un
            FileName = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=FileName)
            ' On va tenter de sauvegarder avec le nom fourni
            If FileName <> False _
            Then ActiveWorkbook.SaveAs FileName:=FileName
        End If
    On Error GoTo 0
   
  ' Fermeture automatique du Classeur s'il a pu être sauvegardé
    If ActiveWorkbook.Saved Then
        ActiveWorkbook.Close
    Else
        Application.DisplayAlerts = True
    End If

A voir également:

Procédure de sauvegarde avec vba
Logiciel de sauvegarde - Guide
Sauvegarde google - Guide
Le point d'entrée de procédure est introuvable dans la bibliothèque de liens dynamiques ✓ - Forum Logiciels
Effacer sauvegarde pokemon y ✓ - Forum DS
Incompatibilité de type vba ✓ - Forum Programmation

1 réponse

Réponse 1 / 1

ptitpanda Messages postés 65 Date d'inscription dimanche 5 août 2012 Statut Membre Dernière intervention 8 avril 2023 8
19 déc. 2020 à 15:55

Bonjour,

Si j'ai bien compris qu'il faut rajouter le nom du mois il suffit de rajouter les lignes après que l'on ait créé le dossier de l'année:

' Procédure de sauvegarde du nouveau Classeur -----------------------------------
    Application.DisplayAlerts = False ' Désactive la confirmation de remplacement
    On Error Resume Next
        'Dossier = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\"
        Dossier = ThisWorkbook.Path & "\..\Factures\AnnexeFactures\"
        ' On ajoute le sous-dossier année
        Filename = Dossier & Format([F1], "yyyy")
        ' On le crée s'il n'existe pas
        If Dir(Filename, vbDirectory) = "" Then MkDir Filename
        
        ' on rajoute le nom du mois
        Filename = Filename & "\" & Format([F1], "mmmm")
        ' On le crée s'il n'existe pas
        If Dir(Filename, vbDirectory) = "" Then MkDir Filename

        'FileName = FileName & "\" & "Annexe_1_Détail_Prestations_Spéciales_Facture_Mois_" & Format([F1], "mmm_yyyy")
        
        Filename = Filename & "\" & "Annexe 2 - Facture " & Format([F1], "mmmm yyyy") & " - Récap prestations spéciales - Ciblex Mions"
        
       
        ' On va tenter de sauvegarder le nouveau Classeur avec le nom prévu
        ActiveWorkbook.SaveAs Filename:=Filename
        If Err > 0 Then
            ' le dossier n'existant probablement pas,
            ' l'utilisateur doit en choisir un
            Filename = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=Filename)
            ' On va tenter de sauvegarder avec le nom fourni
            If Filename <> False _
            Then ActiveWorkbook.SaveAs Filename:=Filename
        End If
    On Error GoTo 0
   
  ' Fermeture automatique du Classeur s'il a pu être sauvegardé
    If ActiveWorkbook.Saved Then
        ActiveWorkbook.Close
    Else
        Application.DisplayAlerts = True
    End If

Je pense que c'est ce que tu souhaitais

Bonne journée

Discussions similaires

Point d'entrée introuvable

"L'indice n'appartient à la sélection" + VBA

VBA : Range avec références variables..

Où se trouve les sauvegardes Steam ?

ouverture d'un fichier excel à partir d'un code VBA

Discussions similaires

Newsletters