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

S

saggigo

XLDnaute Occasionnel
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.
 
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
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 :

Code: 
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+
 

Pièces jointes

  • Test(1).xls
    36.5 KB · Affichages: 35
  • Test(1).xls
    36.5 KB · Affichages: 46
  • Test(1).xls
    36.5 KB · Affichages: 44
Dernière édition:
Vote positif 0 Vote négatif
S

saggigo

XLDnaute Occasionnel
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,
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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 :

Code: 
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+
 

Pièces jointes

  • Test(2).xls
    36.5 KB · Affichages: 34
  • Test(2).xls
    36.5 KB · Affichages: 38
  • Test(2).xls
    36.5 KB · Affichages: 42
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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 :

Code: 
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+
 

Pièces jointes

  • TOTO_140716_112152.xlsm
    16.6 KB · Affichages: 31
  • TOTO_140716_112102.xls
    37 KB · Affichages: 35
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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 :

Code: 
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+
 

Pièces jointes

  • Fichier source(1).xls
    37 KB · Affichages: 32
  • Fichier source(1).xlsm
    16.8 KB · Affichages: 35
  • Fichier source(1).xls
    37 KB · Affichages: 40
  • Fichier source(1).xls
    37 KB · Affichages: 46
Vote positif 0 Vote négatif
S

saggigo

XLDnaute Occasionnel
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.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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 :

Code: 
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+
 

Pièces jointes

  • Modèle(1).zip
    11 KB · Affichages: 23
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Problème lors de la création d'un fichier
Réponses
4
Affichages
349
ChTi160
ChTi160
P
  • Question
Microsoft 365 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
388
phil75016
P
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
403
arnoldbrice19
A
B
  • Question
XL 2019 Exportation Feuille PDF VBA
Réponses
2
Affichages
513
kiki29
kiki29
chaelie2015
  • Question
XL 2013 Modifier un code de sauvegarde
2
Réponses
16
Affichages
847
chaelie2015
chaelie2015
Didier Quilghini
  • Résolu(e)
XL 2019 Définir un nom d'un champ lors d'une macro
2
Réponses
28
Affichages
952
vgendron
vgendron
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
483
Nico2978
Nico2978
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
741
sylvanu
sylvanu
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
424
GClaire
G
F
  • Question
Microsoft 365 Copier un dossier et son contenu puis y enregistrer un classeur. Renommer chaque élément selon des valeurs de cellules
Réponses
1
Affichages
677
Zon
Z

Membres actuellement en ligne

19 membres et 122 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 653
Messages
2 111 576
Membres
111 205
dernier inscrit
Adrien25