Microsoft 365 Creation auto repertoire + fichiers

getget17000

XLDnaute Nouveau
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.
 

Pièces jointes

  • Classeur2.xlsm
    18.7 KB · Affichages: 16

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Accro
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
 

getget17000

XLDnaute Nouveau
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...
 

getget17000

XLDnaute Nouveau
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
Donc vous pouvez adopter la solution du post #2 ?
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

XLDnaute Nouveau
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
Capture d’écran 2022-10-06 154506.jpg
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
vous me demander de tester avec le meme code...
Euh !!! :oops:
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

XLDnaute Nouveau
Euh !!! :oops:
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

XLDnaute Nouveau
Euh !!! :oops:
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
 

Discussions similaires

Réponses
9
Affichages
281

Statistiques des forums

Discussions
312 153
Messages
2 085 800
Membres
102 980
dernier inscrit
brossadan