1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

XL 2016 [VBA] Création Arborescence

Discussion dans 'Forum Excel' démarrée par Hayholten, 5 Décembre 2018.

Tags:
  1. Hayholten

    Hayholten XLDnaute Nouveau

    Inscrit depuis le :
    6 Septembre 2014
    Messages :
    15
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2016 (PC)
    Salut à tous !

    Je viens vers vous pour réussir à automatiser une tâche bien pénible au quotidien.

    Nous gérons au fil de l'année des projets qui sont stockés dans des répertoires sur un serveur selon une arborescence donnée. Dans un fichier Excel de suivi, je crée une ligne par projet et tout un tas d'informations relatifs à ce dernier. J'ai également dans une colonne une formule de concaténation doublée avec une fonction de lien hypertexte afin d'accéder au dossier du projet en un clic.

    Mon but vous l'aurez compris, serait de créer par un simple clic sur un bouton affecté à une macro les répertoires et sous répertoires en question.

    Seulement, je suis une quiche en VBA (évidemment)... J'ai trouvé des codes ici et là mais ne sachant pas réellement les lire, je pédale dur dans le vide. Un exemple :

    https://excel-malin.com/codes-sources-vba/creation-dossiers-et-sous-dossiers-en-vba/

    Je joins un fichier que j'ai créé pour vous donner une idée de ce que je cherche à faire (mon fichier original qui contient beaucoup de données confidentielles est bien plus chargé en informations mais si je choppe la logique, je devrai pouvoir m'adapter).

    Je vous remercie par avance pour l'aide apportée, en espérant avoir été le plus clair possible.

    À vite ;)
     

    Pièces jointes:

  2. Chargement...

    Discussions similaires - [VBA] Création Arborescence Forum Date
    XL 2010 [VBA] Création de graphique sous plage variable Forum Excel 8 Décembre 2016
    [RESOLU] [VBA] Rechercher et Remplacer sur formules pour creation fichier par semaine Forum Excel 8 Janvier 2016
    XL 2010 [Résolu] [VBA] Création de textbox en fonction d'une valeur dans inputbox Forum Excel 12 Décembre 2015
    [VBA] Création de fichiers selon liste et renseigner cellules Forum Excel 18 Août 2015
    [VBA] besoin de vos avis, conseils et idées pour création d'un planning Forum Excel 18 Décembre 2013

  3. BOISGONTIER

    BOISGONTIER XLDnaute Barbatruc

    Inscrit depuis le :
    28 Septembre 2007
    Messages :
    7054
    "J'aime" reçus :
    471
    Habite à:
    Montigny
    Page d'accueil :
    Utilise:
    Excel 2003 (PC)
  4. Hayholten

    Hayholten XLDnaute Nouveau

    Inscrit depuis le :
    6 Septembre 2014
    Messages :
    15
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2016 (PC)
    Hello @BOISGONTIER

    Merci pour ta réponse. Je vais décortiquer le code et voir comment je peux l'adapter à mes besoins (c'est pas intuitif pour moi encore tout ça).

    C'est une question de lecture mais merci pour ton aide ;)
     
  5. Hayholten

    Hayholten XLDnaute Nouveau

    Inscrit depuis le :
    6 Septembre 2014
    Messages :
    15
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2016 (PC)
    J'ai aussi trouvé ce code, qui me semble plus simple :

    Code (Text):
    Sub test()

        Dim strPath  As String
        Dim lCtr     As Long

        strPath = "C:\Temp\"

        arrpath = Split(strPath, "\")
        strPath = arrpath(LBound(arrpath)) & "\"

        For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
            strPath = strPath & arrpath(lCtr) & "\"          
            If Dir(strPath, vbDirectory) = "" Then
                MkDir strPath
            End If
        Next

    End Sub
    En revanche, je suis infoutu de savoir comment j'indique à la fonction d'aller chercher dans une colonne donnée les chemins concaténés de mon arborescence type : "\\172.17.6.199\Projets\DPT Francophone\".
     
  6. Hayholten

    Hayholten XLDnaute Nouveau

    Inscrit depuis le :
    6 Septembre 2014
    Messages :
    15
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2016 (PC)
    Celui me paraît sexy aussi (mais j'ai du mal à voir la différence) :/

    Code (Text):
    Sub MakeFolder()

    Dim strComp As String, strPart As String, strPath As String

    strComp = Range("A1") ' assumes company name in A1
    strPart = CleanName(Range("C1")) ' assumes part in C1
    strPath = "C:\Images\"

    If Not FolderExists(strPath & strComp) Then
    'company doesn't exist, so create full path
        FolderCreate strPath & strComp & "\" & strPart
    Else
    'company does exist, but does part folder
        If Not FolderExists(strPath & strComp & "\" & strPart) Then
            FolderCreate strPath & strComp & "\" & strPart
        End If
    End If

    End Sub

    Function FolderCreate(ByVal path As String) As Boolean

    FolderCreate = True
    Dim fso As New FileSystemObject

    If Functions.FolderExists(path) Then
        Exit Function
    Else
        On Error GoTo DeadInTheWater
        fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
        Exit Function
    End If

    DeadInTheWater:
        MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
        FolderCreate = False
        Exit Function

    End Function

    Function FolderExists(ByVal path As String) As Boolean

    FolderExists = False
    Dim fso As New FileSystemObject

    If fso.FolderExists(path) Then FolderExists = True

    End Function

    Function CleanName(strName as String) as String
    'will clean part # name so it can be made into valid folder name
    'may need to add more lines to get rid of other characters

        CleanName = Replace(strName, "/","")
        CleanName = Replace(CleanName, "*","")
        etc...

    End Function
     

Partager cette page