Discussion :

[francoislaur]

Bonjour a tous,
j'ai besoin de votre aide concernant la création de répertoire et sous répertoire nommé en fonction de la valeur de cellule.

Concrètement j'ai plusieurs client, chacun ayant plusieurs machines et sur chaque machine des travaux à réalisés.

je vous joint mon fichier pour être plus clair.

lors de la sauvegarde je souhaite créer un répertoire principal par année nommé par la valeur de la cel L2,
a l'intérieur de celui-ci les répertoire client nommé par la valeur de la cel E4,
ensuite dans chaque répertoire client un répertoire par machine nommé par la valeur des cel E27 et E29,
et pour finir dans chaque répertoire de machine un répertoire pour chaque intervention nommé par la valeur de la E53 suivi de la valeur des celules E32,F32 et G32 (date d'entrée de la machine en atelier).

J'ai parcouru plusieurs forum j'arrive a créée facilement le premier dossier avec la fonction mkdir mais aprés je suis perdu.

J’espère avoir été clair dans mes explication

Par avance merci a ceux qui se pencherons sur mon problème

François

[SfJ5Rpw8]

Bonjour,

et tu bloque ou ? utilise aussi mkdir pour créer tes autres répertoires ... montre ton code qui ne fonctionne pas..

[francoislaur]

Bonjour Bbil

Merci de ton aide
le code que j'utilise:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub créationdossieretsauve()
 
'creation du nouveau dossier avec nom du client
 
Dim NOMDOSSIER$, Chemin$
NOMDOSSIER = Range("e4") & "_" & Range("e27") & "_" & Range("e29") & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmmss")
MkDir ThisWorkbook.Path & "\" & NOMDOSSIER
Chemin = ThisWorkbook.Path & "\" & NOMDOSSIER & "\"
 
' sauvegarde automatique XLSM dans nouveau dossier
 
ThisWorkbook.SaveCopyAs Chemin & Range("e4") & "_" & Range("e27") & "_" & Range("e29") & ".xlsm"
 
 
End Sub

je veut modifier le code en créant des sous répertoires en fonction des valeurs de cellule comme je l'indique initialement dans ma question

Merci

François

[SfJ5Rpw8]

ben tu dis commencer par :

lors de la sauvegarde je souhaite créer un répertoire principal par année nommé par la valeur de la cel L2,

et je ne vois aucune référence à cette cellule L2 dans ton code .?

[francoislaur]

ne code avec la cellule L2:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub créationdossieretsauve()
 
'creation du nouveau dossier avec nom du client
 
Dim NOMDOSSIER$, Chemin$
NOMDOSSIER = Range("L2")
MkDir ThisWorkbook.Path & "\" & NOMDOSSIER
Chemin = ThisWorkbook.Path & "\" & NOMDOSSIER & "\"
 
' sauvegarde automatique XLSM dans nouveau dossier
 
ThisWorkbook.SaveCopyAs Chemin & Range("e4") & "_" & Range("e27") & "_" & Range("e29") & ".xlsm"
 
 
End Sub

c'est pour les autres sous répertoire que mes connaissances sont insuffisantes ...

merci à toi

François

[SfJ5Rpw8]

et bien que te manque-t-il pour faire le mkDir celon le contenu de la cellule E4 ? c'est la même chose...

[francoislaur]

j'essai de dupliquer le code mais cela ne fonctionne pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub créationdossieretsauve()
 
'creation du nouveau dossier avec nom du client
 
Dim NOMDOSSIER$, Chemin$
NOMDOSSIER = Range("L2")
MkDir ThisWorkbook.Path & "\" & NOMDOSSIER
Chemin = ThisWorkbook.Path & "\" & NOMDOSSIER & "\"
NOMDOSSIER = Range("E4")
MkDir ThisWorkbook.Path & "\" & NOMDOSSIER
Chemin = ThisWorkbook.Path & "\" & NOMDOSSIER & "\"
 
End Sub

j’essaie depuis plusieurs soir mais sans aucun résultats,

[Theze]

Bonjour,

Essai ceci pour voir si ça te convient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Sub CreerDossier()
 
    Dim Fe As Worksheet
    Dim Tbl(1 To 4) As String
    Dim Dossier As String
    Dim DosClient As String
    Dim DosMachine As String
    Dim DosIntervention As String
    Dim I As Integer
 
    Set Fe = Worksheets("PARAMETRE")
 
    With Fe
 
        Dossier = .Range("L2")
        DosClient = .Range("E4")
        DosMachine = .Range("E27") & "_" & .Range("E29")
        DosIntervention = .Range("E53") & .Range("E32") & .Range("F32") & .Range("G32")
 
    End With
 
    'stocke dans un tableau pour boucler ensuite
    Tbl(1) = Dossier
    Tbl(2) = Dossier & "\" & DosClient
    Tbl(3) = Dossier & "\" & DosClient & "\" & DosMachine
    Tbl(4) = Dossier & "\" & DosClient & "\" & DosMachine & "\" & DosIntervention
 
    'le lecteur par défaut est celui où est enregistré le classeur
    ChDir Split(ThisWorkbook.Path, "\")(0) & "\"
 
    For I = 1 To 4
 
        'gère les éventuelles erreurs
        On Error Resume Next
 
        'vérifie si le dossier existe déjà
        If Dir(Tbl(I), vbDirectory) = "" Then
 
            'crée le dossier dans le lecteur
            MkDir Tbl(I)
 
            'si une erreur est générée, message et fin de procédure...
            If Err.Number <> 0 Then
 
                MsgBox "Erreur lors de la création du dossier '" & Split(Tbl(I), "\")(I) & "' !"
 
                Exit Sub
 
            End If
 
        End If
 
    Next I
 
    'enregistre une copie dans le sous-dossier avec le nom du client
    ThisWorkbook.SaveCopyAs Dossier & "\" & DosClient & "\" & DosMachine & "\" & DosIntervention & "\" & DosClient & ".xls"
 
End Sub

Hervé.

Oups, petite erreur ici, la base de la fonction Split est 0 alors que mon tableau est 1 donc, à remplacer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MsgBox "Erreur lors de la création du dossier '" & Split(Tbl(I), "\")(I) & "' !"

par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MsgBox "Erreur lors de la création du dossier '" & Split(Tbl(I), "\")(I - 1) & "' !"

Hervé.

[SfJ5Rpw8]

mais non fait évoluer ta variable Chemin en y concaténant ( avec l'opérateur & ) la valeur de ta cellule E4 , ne repart pas de Thisworkbook.path...

[francoislaur]

Hervé merci a toi j'ai coller ton code mais rien ne se passe..., Bbil merci aussi,

je vais continuer en début d’après midi

merci bien encore et bon apetit a vous tous

François

[francoislaur]

Hervé par ta solution mon problème est résolu, un très grand merci
Merci aussi à toi Bbil pour tes réponses.

bonne continuation à vous tous

François