Création de répertoires et sous répertoires
bonjour
je suis à la recherche de plusieurs petit problèmes lié au fichier joint.
-je souhaite créer , une feuille un dossier nommé avec les valeurs de cellule en colonne "A"+"_"+colonne"B" exemple "Toulouse 2152_k1"
-j'aimerais pouvoir choisir l'emplacement d'enregistrement du dit dossier soit depuis une fonction "Exploreur" soit par une adresse à copier dans une cellule qui me servirait de référence.
-une fois ce dossier créer je voudrais ajouter un dossier en interne qui s'appelle "rapport" cellule D2 et à l’intérieur trois autre dossier avec les nomination des cellules E1;E2;E3
le code ci dessous me créer tout les fichiers de ma colonne A mais après .... c'est le drame
Sub scrat()
Dim cell As Range
Dim chemin As String, NomRep
On Error Resume Next
chemin = "C:\Users\GRAPHISME\Documents\EXCEL\"
For Each cell In Range("A2:A" & Range("A65536").End(xlUp).Row)
'remplace les a par la colonne consernée
If cell <> "" Then
NomRep = cell
MkDir chemin & cell.Value
End If
Next
End Suben PJ le fichier qui me sert à bricoler
D'avance merci aux bonnes âmes pour votre aide
Bonjour,
Voir code ci-dessous et fichier joint.
A te lire. Cdlt
Option Explicit
Public Sub CréationRepDosSub()
'Adapté d'une procédure de Denis Michon
'http://www.excelabo.net/excel/mkdir_xcopy
Dim sH As Worksheet
Dim Chemin As String, Commande As String
Dim derligne As Integer, i As Integer
Dim nomDossier As String
Application.ScreenUpdating = False
Set sH = Worksheets("Feuil1")
'S'assurer d'être sur le bon lecteur où les répertoires
'doivent être créés
ChDrive "c"
Chemin = "c:\Essai\"
With sH
derligne = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To derligne
nomDossier = .Cells(i, 1) & "_" & .Cells(i, 2)
'Crée d'un seul coup tous les répertoires
'et sous-répertoires s'ils sont absents et
'ne modifie à rien s'ils sont présents
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
Next
'à adapter pour la suite...
Chemin = "c:\Essai\Rapport\"
Commande = Environ("comspec") & " /c mkdir " & Chemin
Shell Commande, 0
derligne = .Range("E" & Rows.Count).End(xlUp).Row
For i = 1 To derligne
nomDossier = .Cells(i, 5)
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
Next
End With
Set sH = Nothing
End Sub
Bonjour
Merci d'avoir répondu aussi vite!
Ce n'est pas la même ecriture mais j'arrive un petit peu à le comprendre.
Comment à là place de" \Rapport \"dans l'adresse peut on mettre les dossiers precedement créés ?
Next
'à adapter pour la suite...
Chemin = "c:\Essai\Rapport\"
Commande = Environ("comspec") & " /c mkdir " & Chemin
derligne = .Range("E" & Rows.Count).End(xlUp).Row
For i = 1 To derligne
nomDossier = .Cells(i, 5)
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0l'idée était de mettre le "rapport" avec ses sous dossier en colonne E dans chaque repertoire Toulouse créés.
Je vais surement raconter des bétises mais par exemple ajouter la ligne:
derligne = .Range("E" & Rows.Count).End(xlUp).Row
derligne = .Range("D" & Rows.Count).End(xlUp).Rowon aurait ensuite
SFor i = 1 To derligne
nomDossier = .Cells(i, 4)
nomSousDossier = .Cells(i, 5)
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier & monSousDossier
Shell Commande, 0hell Commande, 0Mais je ne sais pas si ça se redige comme ça
enlever" Rapport" de la barre d'adresse pour mettre ...le dossier créé avec les colonne A et B
je ne sais pas si je suis trés clair ^^
Cdlt
Re,
Le + simple : envoies dans un petit fichier l'arborescence que tu désires
A te relire
Cdlt
Re,
Mise à jour fichier codé en dur. A te relire.
Cdlt
Public Sub CréationRepDosSub()
'Adapté d'une procédure de Denis Michon
'http://www.excelabo.net/excel/mkdir_xcopy
Dim sH As Worksheet
Dim Chemin As String, Commande As String
Dim derligne As Integer, i As Integer
Dim nomDossier As String, Nom As String
Const dV As String = "Devis"
Const rP As String = "Rapport"
Const iT As String = "Itinéraire"
Const pH As String = "Photos"
Const ph_r As String = "Photo_resize"
Const pJ As String = "Projet"
Application.ScreenUpdating = False
Set sH = Worksheets("Feuil1")
ChDrive "c"
Chemin = "c:\Essai\"
With sH
derligne = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To derligne
Nom = .Cells(i, 1) & "_" & .Cells(i, 2) & "\"
nomDossier = Nom & rP
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
nomDossier = Nom & dV
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
nomDossier = Nom & dV & "\" & pJ
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
nomDossier = Nom & "\" & rP & "\" & iT
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
nomDossier = Nom & "\" & rP & "\" & pH
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
nomDossier = Nom & "\" & rP & "\" & ph_r
Commande = Environ("comspec") & " /c mkdir " & Chemin & nomDossier
Shell Commande, 0
Next
End With
Set sH = Nothing
End Sub
Genial!!
Je pense avoir compris le principe. Effectivement , écrit dans le code c'est plus simple.
Est il possible de mettre à la place de : Const dV As String = "Devis" ==> Const dV As String = " valeur Cellule D1 " et ainsi de suite?
Ne pas prendre les valeur d'une colonne mais juste une cellule bien définie
si ce n'est pas possible , tant pis , je ferais avec. C'est déjà très sympa ce que vous avez fait.
Il y un point sur lequel vous n'avez pas émis d'opinion.
Dans la macro , on indique une adresse
Chemin = "c:\Essai\"pour créer les dossiers.
Si on écrit l'adresse dans une cellule peut on se servir de cette valeur pour adresse dans le code?
Ou démarrez une fenêtre "Windows explorer"?
Cordialement