Microsoft 365 Creation auto repertoire + fichiers

getget17000 · 6 Octobre 2022

Bonjour,

Dans le cadre d'un suivi de projet, j'ai créer un tableau Excel dans lequel j'ai la liste de tous les outillages nécessaires.
De là, j'ai créé une macro pour, dans un dossier donné, créer des dossiers pour chaque ligne de mon tableau et des sous dossiers automatiquement via un bouton.
Jusque là pas de soucis.
Maintenant, j'aimerai, lors de la création des ses dossiers et sous dossier, mettre des fichiers automatiquement.
Par exemple: dans le sous dossier "consultation", insérer automatiquement un fichier excel nommé "fiche de consultation"

J'avoue ne pas savoir faire

Je vous joins un fichier exemple

J'espère avoir été clair dans mes explications

Merci d'avance pour votre aide.

sylvanu · 6 Octobre 2022

Bonjour Getget, et bienvenu sur XLD,
Regardez ce LIEN.
Chapitre" Copier un fichier en VBA", il y a la macro type de copie d'un fichier d'un dossier dans un autre :

VB:

'copier fichier (nom reste le même, emplacement différent)
Dim FichierOriginal As String
Dim FichierCopie As String

FichierOriginal = "C:\Test\MonFichier.txt"
FichierCopie = "C:\Archive\MonFichier.txt"

FileCopy FichierOriginal, FichierCopie

PS: plutôt que de dupliquer un fichier comme "fiche de consultation" dans chaque sous dossier, créez des raccourcis, et ne dupliquez que ces raccourcis, ce sont des fichiers comme les autres.

xUpsilon · 6 Octobre 2022

Bonjour,

Si vous partez d'un fichier ouvert, utilisez la méthode File SaveAs : en saisissant dans le premier argument le chemin complet du dossier dans lequel enregistrer, vous pourrez a priori effectuer ce que vous souhaitez.
Voir la documentation microsoft ici

Si je n'ai pas bien compris, merci de bien vouloir reformuler le "insérer un fichier Excel" : s'agit-il d'un fichier ouvert ? Existant ? Généré sur base d'une autre macro ? Une simple sauvegarde d'une feuille ?

Bonne journée,

Edit : Bonjour @sylvanu Visiblement tu as compris autre chose que moi ahah

sylvanu · 6 Octobre 2022

Bonjour Upsilon,
J'ai compris qu'on créée un sous dossier dans lequel on range des fichiers comme "fiche de consultation" qui est la copie d'un fichier type dupliqué dans chaque sous dossier.
Mais ça, Getget nous éclairera.

getget17000 · 6 Octobre 2022

sylvanu à dit:
Bonjour Upsilon,
J'ai compris qu'on créée un sous dossier dans lequel on range des fichiers comme "fiche de consultation" qui est la copie d'un fichier type dupliqué dans chaque sous dossier.
Mais ça, Getget nous éclairera.

Bonjour et merci pour vos réponses,
Pour vous expliquer, mon tableau de base comporte plusieurs dizaines de lignes
Je vais donc avoir autant de dossier dans un répertoire donné.
Dans chaque dossier, j'aurai toujours la même archi (qui sera composée de 4 ou 5 sous dossiers)
Et pour vous répondre, il s'agit bien d'une duplication d'un fichier type (fiche de consultation).
Par exemple, pour le dossier A, j'aurai une fiche de consultation dédiée
Idem pour le dossier B
etc...

sylvanu · 6 Octobre 2022

Donc vous pouvez adopter la solution du post #2 ?

getget17000 · 6 Octobre 2022

sylvanu à dit:
Bonjour Getget, et bienvenu sur XLD,
Regardez ce LIEN.
Chapitre" Copier un fichier en VBA", il y a la macro type de copie d'un fichier d'un dossier dans un autre :

VB:

'copier fichier (nom reste le même, emplacement différent) Dim FichierOriginal As String Dim FichierCopie As String FichierOriginal = "C:\Test\MonFichier.txt" FichierCopie = "C:\Archive\MonFichier.txt" FileCopy FichierOriginal, FichierCopie

PS: plutôt que de dupliquer un fichier comme "fiche de consultation" dans chaque sous dossier, créez des raccourcis, et ne dupliquez que ces raccourcis, ce sont des fichiers comme

sylvanu à dit:

Donc vous pouvez adopter la solution du post #2 ?

Cliquez pour agrandir...

A priori ou, je vais tester

A savoir quand je ne maitrise rien en VBA et que tout ce que je fais c'est en fouinant sur le net
Grace a des gens comme vous

getget17000 · 6 Octobre 2022

sylvanu à dit:
Donc vous pouvez adopter la solution du post #2 ?

Je viens de regarder mais j'avoue ne pas savoir comment l'intégrer dans ma macro pour que le fichier se copie dans chaque sous dossier

getget17000 · 6 Octobre 2022

sylvanu à dit:
Bonjour Getget, et bienvenu sur XLD,
Regardez ce LIEN.
Chapitre" Copier un fichier en VBA", il y a la macro type de copie d'un fichier d'un dossier dans un autre :

VB:

'copier fichier (nom reste le même, emplacement différent) Dim FichierOriginal As String Dim FichierCopie As String FichierOriginal = "C:\Test\MonFichier.txt" FichierCopie = "C:\Archive\MonFichier.txt" FileCopy FichierOriginal, FichierCopie

PS: plutôt que de dupliquer un fichier comme "fiche de consultation" dans chaque sous dossier, créez des raccourcis, et ne dupliquez que ces raccourcis, ce sont des fichiers comme les autres.

J'ai insérer le code dans ma macro comme cela mais j'ai un bug (voir image jointe)

VB:

Sub creer_dossier_sous_dossiers()

Dim ws_data As Worksheet
Dim lstrw As Long
Dim code_designation As String
Dim chemin_dossier As String
Dim chemin_sous_dossier As String

'identifier la feuille
Set ws_data = Worksheets(1)

'dernière ligne
lstrw = ws_data.Cells(Rows.Count, 1).End(xlUp).Row

'boucle sur les données
For i = 2 To lstrw

    code_designation = ws_data.Cells(i, 1) & "_" & ws_data.Cells(i, 2)
    chemin_dossier = "C:\Users\gerald.gonnord\OneDrive - CATANA GROUP\Bureau\test_dossier\" & code_designation & "\"
    
    'vérifier existance du dossier
    If Dir(chemin_dossier, vbDirectory) <> vbNullString Then
    'dossier existe
    Else
    'créer le dossier
    MkDir (chemin_dossier)
    
    'ajout des sous dossiers
    chemin_sous_dossier = chemin_dossier & "01 - Conception\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "02 - Consultation\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "03 - DA - Devis - Commandes - Factures\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "04 - Images\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "05 - Divers\"
    MkDir (chemin_sous_dossier)
    
    'copier fichier (nom différent, emplacement différent)
    Dim FichierOriginal As String
    Dim FichierCopie As String

    FichierOriginal = "CC:\Users\gerald.gonnord\OneDrive - CATANA GROUP\Bureau\test_dossier\Classeur2.xlsm"
    FichierCopie = "chemin_dossier & 02 - Consultation\Fiche_consultation"

    FileCopy FichierOriginal, FichierCopie
    
    End If
    
Next

End Sub

sylvanu · 6 Octobre 2022

Vous avez une erreur dans la déclaration du chemin de destination :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation"

car chemin_dossier est une variable donc hors guillemets.
J'ai essayé cela avec succès mais je répète le nom de fichier dans la destination :

Code:

Sub CopieFichier()
    Dim FicSource$, FicDestination$
    ' Mettre ici le chemin du fichier à copier
    FicSource$ = "C:\Users\PC_PAPA\Desktop\ChoixFeuille (3).xlsm"
    ' Mettre ici le chemin de destination
    FicDestination$ = "C:\Users\PC_PAPA\Desktop\Getget\ChoixFeuille (3).xlsm"
    ' Copie du fichier
    FileCopy FicSource$, FicDestination$
End Sub

A vous de tester.

Sinon testez dans votre appli :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation.xlsm"

avec l'extension sur le fichier de destination, sinon XL génère une erreur. ( si Fiche_consultation est bien le fichier )

getget17000 · 6 Octobre 2022

sylvanu à dit:
Vous avez une erreur dans la déclaration du chemin de destination :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation"

car chemin_dossier est une variable donc hors guillemets.
J'ai essayé cela avec succès mais je répète le nom de fichier dans la destination :

Code:

Sub CopieFichier() Dim FicSource$, FicDestination$ ' Mettre ici le chemin du fichier à copier FicSource$ = "C:\Users\PC_PAPA\Desktop\ChoixFeuille (3).xlsm" ' Mettre ici le chemin de destination FicDestination$ = "C:\Users\PC_PAPA\Desktop\Getget\ChoixFeuille (3).xlsm" ' Copie du fichier FileCopy FicSource$, FicDestination$ End Sub

A vous de tester.

Sinon testez dans votre appli :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation.xlsm"

avec l'extension sur le fichier de destination, sinon XL génère une erreur. ( si Fiche_consultation est bien le fichier )

Ca ne fonctionne pas
De plus, vous me dites que mon code est faux et vous me demander de tester avec le meme code...

sylvanu · 6 Octobre 2022

getget17000 à dit:
vous me demander de tester avec le meme code...

Euh !!!

VB:

Ca:
FichierCopie = "chemin_dossier & 02 - Consultation\Fiche_consultation"
et ça :
FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation"

C'est pas la même chose !!!
"chemin_dossier & 02 - Consultation\Fiche_consultation" c'est une chaine de caractère.
chemin_dossier & "02 - Consultation\Fiche_consultation" c'est la concaténation de chemin_dossier et d'une chaine.

Avez vous essayé :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation.xlsm"

getget17000 · 6 Octobre 2022

sylvanu à dit:
Euh !!!

VB:

Ca: FichierCopie = "chemin_dossier & 02 - Consultation\Fiche_consultation" et ça : FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation"

C'est pas la même chose !!!
"chemin_dossier & 02 - Consultation\Fiche_consultation" c'est une chaine de caractère.
chemin_dossier & "02 - Consultation\Fiche_consultation" c'est la concaténation de chemin_dossier et d'une chaine.

Avez vous essayé :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation.xlsm"

Oui mais cela ne fonctionne pas.

getget17000 · 6 Octobre 2022

sylvanu à dit:
Euh !!!

VB:

Ca: FichierCopie = "chemin_dossier & 02 - Consultation\Fiche_consultation" et ça : FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation"

C'est pas la même chose !!!
"chemin_dossier & 02 - Consultation\Fiche_consultation" c'est une chaine de caractère.
chemin_dossier & "02 - Consultation\Fiche_consultation" c'est la concaténation de chemin_dossier et d'une chaine.

Avez vous essayé :

Code:

FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation.xlsm"

voilà mon code entier

VB:

Sub creer_dossier_sous_dossiers()

Dim ws_data As Worksheet
Dim lstrw As Long
Dim code_designation As String
Dim chemin_dossier As String
Dim chemin_sous_dossier As String

'identifier la feuille
Set ws_data = Worksheets(1)

'dernière ligne
lstrw = ws_data.Cells(Rows.Count, 1).End(xlUp).Row

'boucle sur les données
For i = 2 To lstrw

    code_designation = ws_data.Cells(i, 1) & "_" & ws_data.Cells(i, 2)
    chemin_dossier = "C:\Users\gerald.gonnord\OneDrive - CATANA GROUP\Bureau\test_dossier\" & code_designation & "\"
    
    'vérifier existance du dossier
    If Dir(chemin_dossier, vbDirectory) <> vbNullString Then
    'dossier existe
    Else
    'créer le dossier
    MkDir (chemin_dossier)
    
    'ajout des sous dossiers
    chemin_sous_dossier = chemin_dossier & "01 - Conception\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "02 - Consultation\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "03 - DA - Devis - Commandes - Factures\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "04 - Images\"
    MkDir (chemin_sous_dossier)
    
    chemin_sous_dossier = chemin_dossier & "05 - Divers\"
    MkDir (chemin_sous_dossier)
    
    'copier fichier (nom différent, emplacement différent)
    Dim FichierOriginal As String
    Dim FichierCopie As String

    FichierOriginal = "C:\Users\gerald.gonnord\OneDrive - CATANA GROUP\Bureau\test_dossier\Classeur2.xlsm"
    FichierCopie = chemin_dossier & "02 - Consultation\Fiche_consultation.xlsm"
    
    FileCopy FichierOriginal, FichierCopie
    
    End If
    
Next

End Sub

sylvanu · 6 Octobre 2022

La macro du post #3 CopieFichier marche je l'ai testée.
Modifiez chemin et nom de fichier et testez.
Cela vous fera une bonne base pour modifier votre macro.

Microsoft 365 Creation auto repertoire + fichiers

getget17000

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

xUpsilon

XLDnaute Accro

sylvanu

XLDnaute Barbatruc

getget17000

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

getget17000

XLDnaute Nouveau

getget17000

XLDnaute Nouveau

getget17000

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

getget17000

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

getget17000

XLDnaute Nouveau

getget17000

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Discussions similaires