Discussion :

[emilie46120]

Bonjour à tous,
j'ai besoin de vous.
J'ai un classeur Excel avec une feuille modèle en allant sur l'onglet accueil et en cliquant sue ajouter employé une fenêtre s'ouvre on saisit nom prénom du nouveau employé et cela créer automatiquement la feuille qui se renomme du nom et prénom de l'employé.
Chaque employé a un dossier avec des sous dossier

J'ai un dossier type avec le sous dossier type

J'aimerais pouvoir faire sur ma ma feuille type un bouton qui me permettrais de créer ce dossier avec les sous dossier quand je créer un nouveau agent avec les liens pour aller dans les sous dossier sur chaque partie de de la feuille tableau formation permis ect avec des liens pour aller dans le dossiers directement (rond vert).
et encore mieux lors de la création du nouvel employé que cela ce fasse directement à la création de la feuille Excel.
J'espère que je suis clair
Ci-joint le fichier Excel
Merci pour votre aide

[Qwazerty]

Salut

Il vaut mieux éviter de faire du multiposte, il est préférable de compléter ta demande, si tu n'as pas de réponse c'est probablement que la question est mal comprise, ou que ceux qui seraient en mesure d'y répondre sont aussi ceux qui ne souhaite pas ouvrir de fichier contenant des macro.

J'ai utiliser un bout de code pour un projet boulot, je l'ai prit sur le net, la réf de la source est dans le code. Avant de le posté je l'ai assaini un peu, j'espère qu'il sera toujours fonctionnel

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
Option Explicit
'Source d'origine : https://excel-malin.com/codes-sources-vba/creation-dossiers-et-sous-dossiers-en-vba/#Fonction_VBA_pour_creer_dossiers_et_sous-dossiers_en_meme_temps
Function CreerDossier(Chemin As String) As Boolean
'par: Excel-Malin.com ( https://excel-malin.com )
    On Error GoTo CreerDossierErreur
 
Dim PremierDossier As String
Dim CheminReseau As Boolean
Dim CheminPartielOK As String
Dim CheminPartiel, PartieDeChemin As Integer
Dim PartiesDeChemin As Variant
Dim FSO As Object
 
    If Len(Dir(Chemin, vbDirectory)) <> 0 Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        'suppression du dernier backslash si présent
        If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)
 
        'vérificacion si chemin local ou réseau
        CheminReseau = Left(Chemin, 2) = "\\"
 
        'décomposition du chemin
        CheminPartielOK = ""
        If CheminReseau Then
            PartiesDeChemin = Split(Replace(Chemin, "\\", ""), Application.PathSeparator)
            PremierDossier = LBound(PartiesDeChemin) + 1
        Else
            PartiesDeChemin = Split(Chemin, Application.PathSeparator)
            PremierDossier = LBound(PartiesDeChemin)
        End If
 
        'tests et créations de (sous)dossiers
        For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin)
 
            For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin
 
                CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
 
                If CheminPartiel = PartieDeChemin Then
                    If CheminReseau Then
                        If Right(CheminPartielOK, 1) = Application.PathSeparator Then CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1)
                        If Left(CheminPartielOK, 2) <> "\\" Then CheminPartielOK = "\\" & CheminPartielOK
                    End If
                    If FSO.FolderExists(CheminPartielOK) = False Then MkDir CheminPartielOK
                End If
            Next
            CheminPartielOK = ""
        Next
    End If
 
 
CreerDossierErreur:
 
    If Err.Number <> 0 Then
        Err.Raise Err.Number, "CreerDossier", Err.Description
    Else
        CreerDossier = True
    End If
End Function

Pour créer des dossiers et sous dossiers, il te suffit d'appeler la procédure en lui transmettant le chemin à créer.

++
Qwaz

[emilie46120]

Merci de ton aide, je sais que j'ai posté deux fois j'aurais du modifié mon message désolé
dois modifie le chemin ? si oui ou ? *
Comment le faire fonctionner
merci pour ton aide.

[Philippe Tulliez]

Bonjour,
Personnellement, je n'ouvre pas les classeurs joints

Il existe une instruction toute simple, MkDir, pour créer un répertoire et pour vérifier son existence la fonction Dir

Exemple

Code :

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

1
2
3
4
5
6
7
8
9
Sub t()
  Dim CurrentPath As String
  Dim SubFolder As String
  Dim FullPath As String
  CurrentPath = ThisWorkbook.Path  ' Nom du répertoire courant de l'application
  SubFolder = "TinTin"             ' Nom du sous-dossier à créer
  FullPath = CurrentPath & "\" & SubFolder
  If Dir(FullPath, vbDirectory) = "" Then MkDir FullPath
End Sub

[Qwazerty]

Salut

La fonction que j'ai proposée utilise en effet MkDir et corrige le fait que MfDir ne sait pas créer un arborescence complète.

++
Qwaz

[Igloobel]

Bonjour à tous,

Juste histoire de compléter ce qui a déjà été dit voici un tuto très bien fait qui devrait t'aider à résoudre tes problèmes de création de dossier et sous dossier

http://warin.developpez.com/access/fichiers/#LI-C

perso c'est l'un de mes livres de chevet

[emilie46120]

Bonjour à tous,

Voici mon code qui me permet de créer mon dossier lorsque que je saisi un nouveau agent en cliquant sur mon bouton ajouter un agent qui ouvre une fenêtre ou je dois saisir le nom et prénom et

cela créer une nouvelle feuille (qui copie la feuille modèle) et la renomme du nom prénom et un dossier

Maintenant j'aimerais que quand le dossier se créer il copie un dossier type qui contient des sous dossiers

Si c'est possible

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub dupliquer()
      Dim numFacture As String, sDossier As String
    numFacture = InputBox("NOTER NON PRENON DU NOUVEAU AGENT")
    Sheets("AGENTTYPE").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = numFacture
    'Chemin du  dossier (Dans le même dossier que le classeur ouvert)
    sDossier = ThisWorkbook.Path & "\" & numFacture
    'Si le dossier n'existe pas
    If Dir(sDossier, vbDirectory) = "" Then
    'Création du dossier
        MkDir sDossier
    'Fin de la condition
 End If
End Sub

Merci à tous pour votre futur aide