Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

[saggigo]

Bonjour chers helper 🙂

Voilà, pourriez-vous s'il vous plait m'aider dans la création d'une macro qui me permettra de :

Lorsque j'ai un nom en A1 et que je click sur un bouton "save", il enregistre la feuille dans un nouveau dossier au nom de A1, et que si je créer une nouvelle feuille avec le même nom, il enregistre directement dans le dossier déjà existant, mais si je change le nom de A1, il en créer un nouveau.

Voilà merci beaucoup pour votre aide.

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Bonjour saggigo,

Voyez le fichier joint avec cette macro dans ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminBase$, dossier$, i As Byte
CheminBase = "C:\" 'chemin à adapter
dossier = Feuil1.[A1] 'CodeName de la feuille
If dossier = "" Then Exit Sub
For i = 1 To 9
  If InStr(dossier, Mid("\/:*?""<>|", i, 1)) Then _
    MsgBox "Caractère interdit !": Exit Sub
Next
If Mid(Me.Path, InStrRev(Me.Path, "\") + 1) = dossier Then Exit Sub
Cancel = True
On Error Resume Next
MkDir CheminBase & dossier 'création du dossier s'il n'existe pas
Application.DisplayAlerts = False
Application.EnableEvents = False
Me.SaveAs CheminBase & dossier & "\" & Me.Name
Application.EnableEvents = True
End Sub

Vérifiez bien que cela vous convient.

En effet le même fichier se retrouvera dans des dossiers différents et quand vous enregistrerez, le fichier pouvant exister dans le dossier défini en A1 sera écrasé.

Perso je trouve tarabiscoté ce que vous voulez faire car source d'erreurs.

A+

 

[saggigo]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Oups, vraiment désolé Job75, serieux j'ai pas fait gaffe à ce que j'ecrivait. c'est effectivement pas du tout ça. je m'explique:
- si A1 = X, lorsque j'enregistre j'aurais le nom du dossier crée nom=X, et dans le dossier le nom du fichier: nom_fichier=X_ddmmyyhhmmss (par exemple)
-si A1 = Y, lorsque j'enregistre j'aurais le nom du dossier crée nom=Y, et dans le dossier le nom du fichier: nom_fichier=Y_ddmmyyhhmmss (par exemple)
-Mais si A1 = X encore une fois, j'aurais le le fichier qui sera enregistré dans dossier X, et dans le dossier le nom du fichier: nom_fichier=X_ddmmyyhhmmss mais avec la nouvelle date (même si c'est le meme jour, mais les secondes ne seront jamais les memes)

Voilà? j'espere que la c'est plus logique comme demande, parce que celle d'avant, serieux ... c'est n'importe quoi

Et merci beaucoup Job57.
-si A1 = Y,

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Bonjour saggigo, le forum,

Cette macro traite mieux les caractères interdits et le cas où A1 est vide :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminBase$, dossier As Range, i As Byte
CheminBase = "C:\Mes dossiers\" 'chemin à adapter
Set dossier = Feuil1.[A1] 'CodeName de la feuille
Cancel = True
For i = 1 To 9
  If InStr(dossier, Mid("\/:*?""<>|", i, 1)) Then _
    MsgBox "Caractère interdit !": dossier = ""
Next
On Error Resume Next
MkDir CheminBase & dossier 'création du dossier s'il n'existe pas
Application.DisplayAlerts = False
Application.EnableEvents = False
Me.SaveAs CheminBase & IIf(dossier = "", "", dossier & "\") & Me.Name
Application.EnableEvents = True
End Sub

Notez le CheminBase utilisé ici.

Fichier (2).

A+

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Re,

Nos posts se sont croisés, je vais regarder ce que vous voulez maintenant.

A+

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Re,

Ceci correspond à ce que vous voulez faire :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminBase$, dossier As Range, i As Byte, nomfich$
CheminBase = "C:\Mes dossiers\" 'chemin à adapter
Set dossier = Feuil1.[A1] 'CodeName de la feuille
Cancel = True
For i = 1 To 9
  If InStr(dossier, Mid("\/:*?""<>|", i, 1)) Then _
    MsgBox "Caractère interdit !": dossier = ""
Next
nomfich = IIf(dossier = "", "", dossier & "_") & Format(Now, "yymmdd_hhmmss")
On Error Resume Next
MkDir CheminBase & dossier 'création du dossier s'il n'existe pas
Application.DisplayAlerts = False
Application.EnableEvents = False
Me.SaveAs CheminBase & IIf(dossier = "", "", dossier & "\") & nomfich
Application.EnableEvents = True
End Sub

yymmdd c'est mieux pour le classement.

Fichiers .xls et .xlsm joints.

Nota : bonjour si vous cliquez 20 fois sur "Enregistrer" en une minute...

A+

 

[saggigo]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Job75, t'es un chef. Merci beaucoup.

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Bonjour saggigo,

Cette solution, qui utilise SaveCopyAs, me paraît meilleure :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminBase$, dossier As Range, i As Byte, nomfich$, ext$
CheminBase = "C:\Mes dossiers\" 'chemin à adapter
Set dossier = Feuil1.[A1] 'CodeName de la feuille
Cancel = True
For i = 1 To 9
  If InStr(dossier, Mid("\/:*?""<>|", i, 1)) Then _
    MsgBox "Caractère interdit !": dossier = ""
Next
nomfich = IIf(dossier = "", "", dossier & "_") & Format(Now, "yymmdd_hhmmss")
ext = Mid(Me.Name, InStrRev(Me.Name, "."))
On Error Resume Next
MkDir CheminBase & dossier 'création du dossier s'il n'existe pas
Application.DisplayAlerts = False
Application.EnableEvents = False
Me.Save 'enregistrement normal
Me.SaveCopyAs CheminBase & IIf(dossier = "", "", dossier & "\") & nomfich & ext
Application.EnableEvents = True
End Sub

Avec cette méthode on peut travailler toujours sur le même fichier "Fichier source".

Ce que l'on ne pouvait pas faire avec la méthode précédente.

Fichiers joints.

A+

 

[saggigo]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Merci beaucoup, mais j'ai aussi transformer la feuille en modèle . et ça marche aussi.

Merci beaucoup pour ton aide. tu m'a aidé plus qu'il n'en faut.

 

[saggigo]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Merci beaucoup, mais j'ai aussi transformer la feuille en modèle . et ça marche aussi.

Merci beaucoup pour ton aide. tu m'a aidé plus qu'il n'en faut.

 

[saggigo]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Bonjour Job75,
Voilà j'ai remarqué que quand j'enregistre mon modèle, il enregistre sous une nouvelle feuille mais toujours un modele. serait-il possible d'enregistrer la feuille mais au format basique? juste XLSX. je ne retrouve pas cette info dans la macro.

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Bonjour saggigo,

La macro du post #8 utilise la même extension que celle du fichier source.

C'est la variable ext.

Si vous voulez toujours ".xlsx" donnez-lui cette valeur.

A+

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Re,

Je viens de tester mais ça ne convient pas.

Avec SaveCopyAs le fichier destination doit avoir la même extension que le fichier source.

A+

 

[job75]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Re,

Par contre avec la méthode SaveAs pas de problème.

Il suffit de préciser le format - 51 - du fichier :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminBase$, dossier As Range, i As Byte, nomfich$
CheminBase = "C:\Mes dossiers\" 'chemin à adapter
Set dossier = Feuil1.[A1] 'CodeName de la feuille
Cancel = True
For i = 1 To 9
  If InStr(dossier, Mid("\/:*?""<>|", i, 1)) Then _
    MsgBox "Caractère interdit !": dossier = ""
Next
nomfich = IIf(dossier = "", "", dossier & "_") & Format(Now, "yymmdd_hhmmss")
On Error Resume Next
MkDir CheminBase & dossier 'création du dossier s'il n'existe pas
Application.DisplayAlerts = False
Application.EnableEvents = False
Me.SaveAs CheminBase & IIf(dossier = "", "", dossier & "\") & nomfich, 51
Application.EnableEvents = True
End Sub

Fichier zippé joint.

A+

 

[saggigo]

Re : Enregistrer sous un dossier mais s'il existe déjà ne pas créer un nouveau

Merci beaucoup Job75, ton aide m'a vraiment sauvé. désolé pour le retard de réponse mais j’étais absent 🙂