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 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
230
phil75016
P
B
  • Question
XL 2019 Exportation Feuille PDF VBA
Réponses
2
Affichages
251
kiki29
kiki29
chaelie2015
  • Question
XL 2013 Modifier un code de sauvegarde
2
Réponses
16
Affichages
514
chaelie2015
chaelie2015
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
181
sylvanu
sylvanu
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
139
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
480
Zon
Z
G
  • Question
XL 2021 Dictionnaire - Calcul ne s'effectue pas
Réponses
2
Affichages
195
gvives
G
A
  • Question
XL 2021 Comment créer un code VBA afin de création un chemin d'accès universel
Réponses
8
Affichages
817
AugusteP
A
Olive de BI
  • Résolu(e)
Microsoft 365 Enregistrer dans une feuille mais pas dans une autre
Réponses
11
Affichages
376
Olive de BI
Olive de BI
M
  • Résolu(e)
XL 2016 Fonction VBA créer un fichier zip pour X fichier CSV dans un dossier spécifique
Réponses
4
Affichages
1 K
patricktoulon
patricktoulon

Membres actuellement en ligne

8 membres et 89 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
312 215
Messages
2 086 326
Membres
103 180
dernier inscrit
Vcr