Création dossiers et sous dossiers depuis valeur cellules

Bonjour à tous,

Je suis face à un problème de création de dossiers et sous-dossiers sous vba ; j'ai fait plusieurs recherches un peu partout mais ne réussissant pas à comprendre les codes que je rencontre je n'arrive pas à les adapter à mon fichier.

L'idée est la suivante :

Je travaille sur un modèle de devis que je souhaiterais enregistrer automatiquement dans des dossiers datés ; à savoir :

Dossier "2017"

  • ------- Sous dossier "01" pour Janvier
  • ------- Sous dossier "02" pour Février etc.

Afin d'automatiser la sauvegarde, je voudrais que les dossiers et sous dossiers se créent automatiquement en fonction du moment où le devis est établi.

J'ai donc indiqué en Feuille 2 :

Cellule G1 : "=TEXTE(AUJOURDHUI();"aaaa")" ----> ce qui me donne l'année en cours en format texte et qui doit devenir mon dossier

Cellule H1 : "=TEXTE(AUJOURDHUI();"mm")" ----->ce qui me donne le mois en cours en format texte et qui doit devenir mon sous dossier

Maintenant je souhaite créer un bouton "Enregistrer Sous" qui doit donc :

1 vérifier l'existence des dossiers et sous dossiers - en fonction donc des valeurs en G1 et H1

2 créer les dits dossiers et / ou sous dossiers manquants

3 enregistrer le fichier à la bonne place.

Le problème étant : si je crée mon premier devis aujourd'hui, il n'existe donc ni dossier "2017" ni sous-dossier "07" ; il faudrait donc créer ET le dossier ET le sous dossier.

Auriez-vous un code me permettant de mettre cela au point ? (si possible avec quelques explications afin de me coucher un peu plus intelligent ce soir).

Je vous remercie par avance pour votre aide.

Bonjour

Regardfe si ce classeur peut t'aider:

Création sur le bureau d'un dossier de l'année en cour, un sous dossier par mois, un sous dossier par jour.

Cordialement

Bonjour Efgé,

Merci pour ton retour.

Malheureusement je ne comprends pas le code de ton fichier ; je n'arrive donc pas à l'adapter à mes besoins.

Pour info, mes connaissances actuelles en vba se limitent plus ou moins à recopier des bouts de codes en espérant les assembler correctement pour faire fonctionner le tout.

Pour le coup je n'arrive pas à détailler dans ton code ce qui pourrait me servir

Re

Le code est commenté pourtant...

Si tu mets un fichier exemple anonyme et représentatif de ton modèle, on pourra avancer.

Cordialement

Bonjour,

Un code simple pour créer le répertoire s'il n'existe pas :

Sub test()
Dim chemin As String
  chemin = ThisWorkbook.Path & "\" & CStr(Year(Date))
  If Dir(chemin, vbDirectory) = "" Then MkDir chemin
'Edit :
'    chemin = chemin & "\" & CStr(Month(Date))
    chemin = chemin & "\" & Format(Month(Date), "00")
  If Dir(chemin, vbDirectory) = "" Then MkDir chemin
End Sub

En effet, avec un fichier ça serait plus simple ; donc le voilà ci-joint.

Les dossiers que je souhaiterais créer doivent aller dans :

C:\Users\Documents\Tests Excel\Dossier Test Devis

Quand je clique sur le bouton, les règles que je voudrais mettre en place sont :

- Vérifier que dans le chemin ci-dessus si le dossier "2017" existe

- Si oui vérifier si dans "2017", le dossier "07" existe

- Si oui enregistrer une copie de la feuille 1

- Si non créer le dossier "07" puis enregistrer une copie de la feuille 1

- Si non créer le dossier "2017" puis le sous dossier "07" puis sauvegarder une copie de la feuille 1

Pour le moment, créer un dossier ne me pose pas trop de problème ; c'est créer un dossier + un sous dossier qui bloque.

Actuellement je voudrai créer un dossier + un sous dossier en fonction des valeurs d'une cellule (valeur = Année en cours et mois en cours).

J'ai vu cependant qu'il était possible de s'appuyer directement sur du code qui aurait la même fonction que la formule =AUJOURDHUI

Je vous remercie d'avance pour votre aide.

Re

En partant de ton exemple:

Sub Enregistrer_sous()
    Dim Nom_Fichier As String, Chemin As String, Dossier As String, Sous_dossier As String

    Nom_Fichier = Sheets("Feuil1").Range("B10") & " - Devis " & Sheets("Feuil1").Range("F5") & ".xlsx"

    Chemin = "C:\Users\Documents\Tests Excel"
    'Chemin = CreateObject("WScript.Shell").SpecialFolders("Desktop") 'pour les test

    Dossier = Chemin & "\" & Year(Date)
    If Dir(Dossier, vbDirectory) = "" Then MkDir Dossier
    Sous_dossier = Dossier & "\" & Format(Month(Date), "00")
    If Dir(Sous_dossier, vbDirectory) = "" Then MkDir Sous_dossier
    ThisWorkbook.Sheets("Feuil1").Copy
    ActiveWorkbook.SaveAs Filename:=Sous_dossier & "\" & Nom_Fichier
End Sub

Mais tu ne devrais pas mettre le bouton sur la feuille que tu en registres....

Cordialement

Re,

Il est plus simple d'appliquer les règles que je t'avais proposé soit :

  • Vérifier que dans le chemin ci-dessus si le dossier "2017" existe
  • Si non créer le dossier "2017" (et si oui continuer ci-dessous)
  • Vérifier que dans le dossier ci-dessus si le sous-dossier "07" existe
  • Si non créer le sous-dossier "07" (et si oui continuer ci-dessous)
  • puis enregistrer une copie de la feuille 1

Ou, si tu préfères, il suffit de remplacer le Else de ton code par End If

Super !!

Cela fonctionne impeccable ! Et le code semble pourtant tellement simple en comparaison de ce que j'ai pu trouver ici et là sur internet.

Merci beaucoup pour votre aide;

Et passez une excellente journée !

Rechercher des sujets similaires à "creation dossiers valeur"