IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

création de fichier et sous fichier avec un bouton


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Femme Profil pro
    Responsable de compte
    Inscrit en
    janvier 2022
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Lot (Midi Pyrénées)

    Informations professionnelles :
    Activité : Responsable de compte
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : janvier 2022
    Messages : 5
    Points : 4
    Points
    4
    Par défaut création de fichier et sous fichier avec un bouton
    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
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 857
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 857
    Points : 8 473
    Points
    8 473
    Par défaut
    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

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  3. #3
    Candidat au Club
    Femme Profil pro
    Responsable de compte
    Inscrit en
    janvier 2022
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Lot (Midi Pyrénées)

    Informations professionnelles :
    Activité : Responsable de compte
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : janvier 2022
    Messages : 5
    Points : 4
    Points
    4
    Par défaut MErci
    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.

  4. #4
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    janvier 2010
    Messages
    11 438
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : janvier 2010
    Messages : 11 438
    Points : 27 392
    Points
    27 392
    Billets dans le blog
    42
    Par défaut
    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
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Ma dernière contribution : VBA - Les macros complémentaires

  5. #5
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 857
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 857
    Points : 8 473
    Points
    8 473
    Par défaut
    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

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  6. #6
    Membre expert
    Avatar de Igloobel
    Homme Profil pro
    Développeur ERP - VBA
    Inscrit en
    septembre 2005
    Messages
    1 827
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Développeur ERP - VBA
    Secteur : Industrie

    Informations forums :
    Inscription : septembre 2005
    Messages : 1 827
    Points : 3 367
    Points
    3 367
    Billets dans le blog
    1
    Par défaut
    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
    Ils ne savaient pas que c'était impossible ... du coup ils l'ont fait (Mark Twain)

    n'oubliez pas de si les messages vous aide ou sont pertinents et de mettre quand cela est !

  7. #7
    Candidat au Club
    Femme Profil pro
    Responsable de compte
    Inscrit en
    janvier 2022
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Lot (Midi Pyrénées)

    Informations professionnelles :
    Activité : Responsable de compte
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : janvier 2022
    Messages : 5
    Points : 4
    Points
    4
    Par défaut
    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 Nom : Capture.PNG
Affichages : 40
Taille : 14,5 Ko et Nom : Capture2.PNG
Affichages : 34
Taille : 10,2 Ko

    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

Discussions similaires

  1. probleme de création de fichiers avec une boucle
    Par bobo696 dans le forum Débuter
    Réponses: 3
    Dernier message: 19/01/2009, 14h45
  2. Création de fichier avec fopen
    Par mcdelay dans le forum Langage
    Réponses: 2
    Dernier message: 28/03/2008, 09h08
  3. création de fichier avec droits
    Par jean-jacques varvenne dans le forum Général Python
    Réponses: 2
    Dernier message: 25/02/2008, 17h40
  4. création de fichier avec commande DOS
    Par staticx dans le forum Scripts/Batch
    Réponses: 2
    Dernier message: 21/08/2007, 09h59
  5. Création de fichier avec Powerbuilder
    Par cradleofpain dans le forum Powerbuilder
    Réponses: 8
    Dernier message: 07/05/2007, 10h37

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo