Discussion :

[vodkysan]

Bonjour à toutes et à tous !

Je vous remercie pour l'aide précieuse que vous m'avez apporté sur des précédents topic mais je n'arrive toujours pas à réaliser ma solution c'est pour cela que je me tourne vers vous

Je veux mettre en place un script sur VBA qui me permettrai de créer une arborescence de dossier et de sous dossier en fonction du contenu d'un tableur Excel et en fonction du chemin que l'utilisateur choisira.

Voici à quoi ressemble mon tableur :



Le but est de créer une arborescence à partir d'un chemin que l'utilisateur choisi, il faudrait que le script ne prenne pas en compte la 1ère ligne et commence à partir de la deuxième.
Il faudrait également, pour la création des dossiers, fusionner les cellules A2 "ajouter un _" B2, notre dossier maître serait donc 1_TITI.
Puis on créer dans 1_TITI, le dossier 1.1_Produit A, puis 1_2 Produit B, etc

Mon code me permet de récupérer le chemin que l'utilisateur choisi mais impossible de créer cette arborescence dedans :/

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
Sub test_creation()
 
    Dim retour As Long
    retour = MsgBox(Prompt:="Merci de m'indiquer le chemin où je dois créer l'arborescence s'il vous plaît", Buttons:=vbYesNo)
    'Si on a cliqué sur Oui pour que l'utilisateur puisse écrire le chemin
 
    If retour = vbYes Then
        Dim chemin As String
        chemin = InputBox(Prompt:="Chemin : ")
        MsgBox (chemin)
 
        Dim confirmation As String
        confirmation = MsgBox(Prompt:="Confirmez-vous le chemin que vous venez d'écrire ?", Buttons:=vbYesNo)
 
        If confirmation = vbYes Then
            MsgBox "Je m'occupe de la création des dossier"
        Else
            MsgBox "Je vous prie de recommencer depuis le début"
        End If
 
    Else
        MsgBox "Merci de relancer le script pour créer l'arborescence"
    End If

Si vous avez besoin de plus d'informations, n'hésitez pas à répondre sur ce topic ou m'envoyer un message

Cordialement, bonne journée.

[boisgontierjacques]

Bonjour,


Exemple de TreeView

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
Dim tw As MSComctlLib.TreeView
Dim n, Rng
Private Sub UserForm_Initialize()
  Set Rng = Range("A2:C" & [A65000].End(xlUp).Row)
  pere = "0"
  nomPere = Application.VLookup(pere, Rng, 2, False)
  Set tw = Me.MonArbre
  n = Rng.Rows.Count
  tw.Nodes.Add(, , "NoeudMat" & pere, nomPere).Expanded = True    ' Racine arbre
  Fils pere
End Sub
 
Sub Fils(parent)       ' procédure récursive
  For i = 2 To n
    cd = CStr(Rng(i, 1))
    niv = Len(cd) - Len(Replace(cd, ".", ""))
    If niv = 0 Then temp = "0" Else p = InStrRev(cd, ".") - 1: temp = Left(cd, p)
    If temp = parent Then
      tw.Nodes.Add("NoeudMat" & parent, tvwChild, "NoeudMat" & _
        CStr(Rng(i, 1)), CStr(Rng(i, 1)) & ": " & Rng(i, 2) & "-").Expanded = True
      Fils CStr(Rng(i, 1))
    End If
  Next i
End Sub

Boisgontier

[vodkysan]

Merci pour ta réponse rapide !

Lorsque j'essaye d’exécuter le code, il m'indique

Erreur de compilation: Type défini par l'utilisateur non défini

En surlignant cette phrase Dim tw As MSComctlLib.TreeView.

[vodkysan]

Voici mon code pour récupérer le chemin mais le seul hic est la création des dossiers :

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
60
61
62
63
64
65
66
67
Sub test_creation()
 
    Dim retour As Long
    retour = MsgBox(Prompt:="Merci de m'indiquer le chemin où je dois créer l'arborescence s'il vous plaît", Buttons:=vbYesNo)
    'Si on a cliqué sur Oui pour que l'utilisateur puisse écrire le chemin
 
    If retour = vbYes Then
        Dim Chemin As String
        Chemin = InputBox(Prompt:="Chemin : ")
 
        Dim confirmation As String
        confirmation = MsgBox(Prompt:="Confirmez-vous le chemin que vous venez d'écrire ?", Buttons:=vbYesNo)
        MsgBox (Chemin)
 
        If confirmation = vbYes Then
            MsgBox "Je m'occupe de la création des dossier"
        Else
            MsgBox "Je vous prie de recommencer depuis le début"
        End If
 
    Else
        MsgBox "Merci de relancer le script pour créer l'arborescence"
    End If
 
    Dim FSO As Object, Dossier As Object
    Dim oWSS As Object, oGenvag As Object
    Dim C As Range
 
    Set oWSS = CreateObject("WScript.Shell")
 
    chemin_creation = Chemin
 
    Set oWSS = Nothing
    Set FSO = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set Dossier = FSO.GetFolder(chemin_creation & "\F")
    If Not Dossier Is Nothing Then
        MsgBox "Le dossier F existe"
        Exit Sub 'Si le dossier F existe déjà, le programme s'arrête
 
        Application.Wait (Now + TimeValue("0:00:03"))  'pause
 
    End If
 
 
    MkDir chemin_creation & "\F"
    ChDir chemin_creation & "\F"
    For Each C In Range([A2], Cells(Rows.Count, 1).End(xlUp))
        ChDir chemin_creation & "\F"
        For i = 1 To 100
            If Cells(C.Row, i).Value = "" Then Exit For
            If Cells(C.Row, i + 1) <> "" And Cells(C.Row, i) <> Cells(C.Row - 1, i) Then
 
                MkDir CurDir & "\" & Cells(C.Row, i)
                Application.Wait (Now + TimeValue("0:00:03"))  'pause
 
                ChDir CurDir & "\" & Cells(C.Row, i)
                Application.Wait (Now + TimeValue("0:00:03"))  'pause
 
            Else
                ChDir CurDir & "\" & Cells(C.Row, i)
            End If
        Next i
    Next C
    On Error GoTo 0
    MsgBox "Finalisation"
End Sub

Avec ce code que j'ai récupéré sur un autre topic j'arrive à me déplacer sur le chemin voulu mais pas à créer les dossier en fonction du contenu de mon tableur :/

[jurassic pork]

hello,

Merci pour ta réponse rapide !

Lorsque j'essaye d’exécuter le code, il m'indique "Erreur de compilation: Type défini par l'utilisateur non défini"

En surlignant cette phrase "Dim tw As MSComctlLib.TreeView"

Dans VBA , dans le menu Outils/Références as-tu la référence Microsoft Windows Common Controls 6.0 qui apparaît et est-elle cochée ? :



Ami calmant, J.P

[vodkysan]

Hello !

Je l'ai mais avec le service pack 4 et non le 6 :/



Lorsque je lance le script, il m'indique une erreur avec le mot "Me"



Cordialement

[vodkysan]

Petite modification du code

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
60
61
62
63
64
65
66
67
Sub test_creation()
 
    Dim retour As Long
    retour = MsgBox(Prompt:="Merci de m'indiquer le chemin où je dois créer l'arborescence s'il vous plaît", Buttons:=vbYesNo)
    'Si on a cliqué sur Oui pour que l'utilisateur puisse écrire le chemin
 
    If retour = vbYes Then
        Dim Chemin As String
        Chemin = InputBox(Prompt:="Chemin : ")
        Dim confirmation As String
        confirmation = MsgBox(Prompt:="Confirmez-vous le chemin que vous venez d'écrire ?", Buttons:=vbYesNo)
        MsgBox (Chemin)
 
        If confirmation = vbYes Then
            MsgBox "Je m'occupe de la création des dossier"
        Else
            MsgBox "Je vous prie de recommencer depuis le début"
            Exit Sub
        End If
    Else
        MsgBox "Merci de relancer le script pour créer l'arborescence"
    End If
 
    Dim FSO As Object, Dossier As Object
    Dim oWSS As Object, oGenvag As Object
    Dim C As Range
    Set oWSS = CreateObject("WScript.Shell")
    chemin_creation = Chemin
    Set oWSS = Nothing
    Set FSO = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set Dossier = FSO.GetFolder(chemin_creation & "\F")
 
    If Not Dossier Is Nothing Then
        MsgBox "Le dossier F existe"
        Exit Sub 'Si le dossier F existe déjà, le programme s'arrête
        Application.Wait (Now + TimeValue("0:00:03"))  'pause
    End If
 
    'Pour copier le contenu de deux colonnes pour les fusionner en une seule
    For i = 1 To Range("A65536").End(xlUp).Row
        Range("a" & i) = Range("a" & i) & "_" & LTrim(Range("b" & i))
        Columns("B:B").ClearContents
    Next
 
    'Création répertoire F
    MkDir chemin_creation & "\F"
    ChDir chemin_creation & "\F"
 
    For Each C In Range("A65536", Cells(Rows.Count, 1).End(xlUp))
        ChDir chemin_creation & "\F"
        For i = 2 To 100
            If Cells(C.Row, i).Value = "" Then Exit For
            If Cells(C.Row, i + 1) <> "" And Cells(C.Row, i) <> Cells(C.Row - 1, i) Then
                MkDir CurDir & "\" & Cells(C.Row, i)
                Application.Wait (Now + TimeValue("0:00:03"))  'pause
                ChDir CurDir & "\" & Cells(C.Row, i)
                Application.Wait (Now + TimeValue("0:00:03"))  'pause
            Else
                ChDir CurDir & "\" & Cells(C.Row, i)
                Application.Wait (Now + TimeValue("0:00:03"))  'pause
            End If
        Next i
    Next C
    On Error GoTo 0
    MsgBox "Finalisation"
End Sub

Grosso modo, j'arrive à fusionner le contenu des deux colonnes en une seule.

Je n'arrive toujours pas à créer les dossier en fonction du contenu de la colonne A, il me créer le répertoire F où je veux mais pas les dossier

Help :/

[Pierre Fauconnier]

Salut.

Perso, j'ajouterais une colonne au tableau pour créer le chemin complet du dossier. Après, une simple boucle crée les dossiers à la volée

Code :

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

1
2
3
4
5
6
7
Sub CreateFolders()
  Dim c As Range
 
  For Each c In Range("t_Dossiers[Chemin]")
    MkDir c.Value
  Next
End Sub

Attention. Je n'ai mis ici aucune sécurité. Cela implique que le dossier en G1 doit préexister, et que tu ne peux lancer la macro qu'une seule fois. C'est le concept que je te donne ici, qui est fidèle à ma signature (quand tu fais du vba pour Excel, pense Excel avant de penser VBA => Cette façon d'aborder les choses simplifie le code pour qui n'est pas programmeur de métier), pas le truc tout ficelé final.