Créer répertoires en fonction d'une cellule

Bonjour,

Est-ce qu'il est possible de créer des répertoires automatiquement en fonction d'une cellule.

Par exemple si j'écris en A1 : 100 , A2 200, A3 300 etc.

Excel crée automatiquement des dossiers tel quel :

C:\Documents and Settings\Planning\Dossier_archive_100

C:\Documents and Settings\Planning\Dossier_archive_200

C:\Documents and Settings\Planning\Dossier_archive_300

Et si le dossier existe déjà, alors ne pas le créer.

Bonjour geoffrey,

Un code à mettre dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    rep = "C:\Documents and Settings\Planning\Dossier_archive_" & Target
    On Error Resume Next
    ChDir rep
    If Err.Number <> 0 Then MkDir rep
End If
End Sub

Est-il possible de créer également des sous répertoires grâce à la macro ? Enfaite j'utilisais un .bat pour créer les répertoires. Voici la structure du bat :

cd Dossier_archive_100

md Dossier_client

md Dossier_interne

cd Dossier_interne

md Performances

md Defauts

md Vibrations

cd Vibrations

md 1ere_Marche

C'est possible de l'intégrer dans VB ?

Bonjour

A essayer

Re,

Bonjour Banzai64,

geoffrey90 a écrit :

Est-il possible de créer également des sous répertoires grâce à la macro ?

geoffrey90 a écrit :

Est-il possible de créer également des sous répertoires grâce à la macro ? Enfaite j'utilisais un .bat pour créer les répertoires. Voici la structure du bat :

cd Dossier_archive_100

md Dossier_client

md Dossier_interne

cd Dossier_interne

md Performances

md Defauts

md Vibrations

cd Vibrations

md 1ere_Marche

C'est possible de l'intégrer dans VB ?

Le code modifié (j'ai enlevé le On error resume next qui permettait de gérer les dossiers qui n'existaient pas. Passer par Dir(xxx, vbDirectory) c'est mieux) :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
        rep = "C:\Documents and Settings\Planning\Dossier_archive_" & Target
        If Target <> "" Then
            If Dir(rep, vbDirectory) = "" Then 'si le répertoire n'existe pas
            MkDir rep 'on crée le répertoire
            ChDir rep 'cd Dossier_archive_xxx
            MkDir "Dossier_client" 'md Dossier_client
            MkDir "Dossier_interne" 'md Dossier_interne
            ChDir "Dossier_interne" 'cd Dossier_interne
            MkDir "Performances" 'md Performances
            MkDir "Defauts" 'md Defauts
            MkDir "Vibrations" 'md Vibrations
            ChDir "Vibrations" 'cd Vibrations
            MkDir "1ere_Marche" 'md 1ere_Marche
            End If
        End If
    End If
End Sub

Edit : code réadapté

Merci Banzai64 et vba-new. L'idée du bouton pour créer les répertoires est intéressante mais il vaudrait mieux que ce soit automatique.

Etant donnée que les données proviennent d'une formule, je pense que cela est impossible ?

Ci-joint un exemple du processus.

As-tu essayé le code que je t'ai fourni ?

Il faut mettre le code dans la feuille Données puisque tes formules font référence à cette feuille.

Clic droit sur l'onglet Données / Visualiser le code / colle le code proposé plus haut (je l'ai réadapté).

Effectivement je vais mettre directement la macro où on entre les "Données sources" du coup. En revanche, avec ton code, il crée bien le répertoire mais il n'y a pas les sous répertoires ( l'arborescence ).

Et selon l'inscription dans la colonne, le lien ne serait pas le même. C'est possible de faire ça ? L'exemple est dans le fichier exemple.xls plus haut.

Colonne A : 5555 Colonne B : Type A

Lien où créer le répertoire : C:/Mes Documents/Type A/ Dossier archive 5555

Colonne A : 2222 Colonne B : Type B

Lien où créer le répertoire : C:/Mes Documents/Type B/ Dossier archive 2222

Etc.

Du coup je vais reprendre ton idée du bouton Banzai . Lorsque colonne A et B remplie, on clic sur ton bouton et le répertoire se crée. Mais si on clic à nouveau, que se passe t-il ? Y a moyen de rajouter une colonne où elle renseigne si le dossier est créé ou non ?

Si ce n'est pas possible à ajouter dans la macro, je peux utiliser la fonction personnalisé de vba-new pour vérifier si le lien est bon ou pas

merci encore pour votre aide

up

Bonjour

Une autre version à tester

Bonjour,

Merci pour cette nouvelle version mais je ne peux pas rajouter des colonnes dans le tableau "source" où il y aura cette macro pour créer les répertoires. J'essai de reprendre le code de vba-new pour l'adapter mais je galère

Ci-joint l'exemple très concret de l'automatisation que j'aimerais réaliser.

Détails :

1. Lorsque A et C remplis on clic sur un bouton . ( Ou alors, si c'est possible, les répertoires se crée quand on quitte le tableau ).

/!\ Le répertoire de destination varie en fonction de la colonne C

Voilà, si c'est faisable, tout sera ok

Encore merci pour votre aide

Est-ce trop compliqué à faire ?

Bonjour geoffrey,

C'est faisable mais c'est ta demande qui n'est plus trop claire !

geoffrey90 a écrit :

Lorsque A et C remplis on clic sur un bouton . ( Ou alors, si c'est possible, les répertoires se crée quand on quitte le tableau ).

Bonjour vba-new,

Effectivement je n'ai pas été très clair sur ce point.

J'aimerais que le répertoire se crée quand on quitte les cellules de la colonne C. ( Si on quitte la cellule A et que la C n'est pas remplie, cela ne pourra pas marcher puisque le répertoire de destination varie en fonction de la colonne C ).

Re,

Un essaie avec le code suivant (à placer dans le code de la feuille contenant les données) :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rep1 As String, rep2$, rep$
    If Target.Count > 1 Then Exit Sub    'on sort de la procédure si plusieurs cellules sélectionnées
    If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
        rep1 = "C:\Archives\Recensement\Dossier d'archivage " & Target
        rep2 = "Dossier_d'archive_" & Target.Offset(, -2)    'Target.Offset(, -2)=valeur de la colonne A
        rep = rep1 & "\archivage\" & rep2
        If Target <> "" Then
            If Dir(rep, vbDirectory) = "" Then    'si le répertoire n'existe pas
                MkDir rep1    'on crée le début du répertoire
                ChDir rep1    'on se place dans le répertoire nouvellement créé
                MkDir "archivage"    'md archivage
                ChDir "archivage"    'on se place dans le dossier archivage
                MkDir rep2    'on crée le Dossier_d'archive_XXX
                ChDir rep2
                MkDir "Dossier_client"    'md Dossier_client
                MkDir "Dossier_interne"    'md Dossier_interne
                ChDir "Dossier_interne"    'cd Dossier_interne
                MkDir "Performances"    'md Performances
                MkDir "Defauts"    'md Defauts
                MkDir "Vibrations"    'md Vibrations
                ChDir "Vibrations"    'cd Vibrations
                MkDir "1ere_Marche"    'md 1ere_Marche
            End If
        End If
    End If
End Sub

... génial. Je vais adapter au tableau en question et aux liens du serveur. Après un essai en local ça à l'air d'être parfait!

Merci bcp

Je te tiens au courant

-- 18 Août 2011, 14:22 --

Il y a une erreur quand il y a 2 mêmes valeurs dans la colonne C

Re,

geoffrey90 a écrit :

Il y a une erreur quand il y a 2 mêmes valeurs dans la colonne C

Erreur d'exécution 75

Erreur d'accès Chemin/fichier.

Il y a cette erreur car le répertoire existe déjà puisqu'une autre ligne possède la même valeur dans la colonne C.

Une autre approche. On donne le chemin complet (en supposant que le dossier Recensement existe) :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rep1 As String, rep2$, rep$
    If Target.Count > 1 Then Exit Sub    'on sort de la procédure si plusieurs cellules sélectionnées
    If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
        rep1 = "C:\Archives\Recensement\Dossier d'archivage " & Target
        rep2 = "Dossier_d'archive_" & Target.Offset(, -2)    'Target.Offset(, -2)=valeur de la colonne A
        rep = rep1 & "\archivage\" & rep2
        If Target <> "" Then
            If Dir(rep, vbDirectory) = "" Then    'si le répertoire n'existe pas
                If Dir(rep1, vbDirectory) = "" Then MkDir rep1    'on crée le début du répertoire
                If Dir(rep1 & "\archivage", vbDirectory) = "" Then MkDir rep1 & "\archivage"    'md archivage
                MkDir rep    'on crée le Dossier_d'archive_XXX
                MkDir rep & "\Dossier_client"    'md Dossier_client
                MkDir rep & "\Dossier_interne"    'md Dossier_interne
                MkDir rep & "\Dossier_interne\Performances"    'md Performances
                MkDir rep & "\Dossier_interne\Defauts"    'md Defauts
                MkDir rep & "\Dossier_interne\Vibrations"    'md Vibrations
                MkDir rep & "\Dossier_interne\Vibrations\1ere_Marche"    'md 1ere_Marche
            End If
        End If
    End If
End Sub

ça fonctionne à merveille !

Dernière question, si je veux supprimer le répertoire "archivage" entre "Dossier d'archivage" et "Dossier d'archive", comment faire ?

C'est nécessaire d'avoir un répertoire entre ces deux "répertoires variables" ?