Procédure de sauvegarde avec vba
LinDouch42
-
ptitpanda Messages postés 67 Statut Membre -
ptitpanda Messages postés 67 Statut Membre -
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
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
1 réponse
-
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
