XL 2016 Création de répertoires

[christ77000]

Bonjour à tous, j'aurais besoin d'un petit coup de main pour savoir s'i y avait un moyen pour faire plus simple. Vu mon niveau en vba j'ai pas su faire mieux

explications : dans ma feuille Menu j'ai de R1 à R25 le chemin réseau des différents répertoires et en S1 le nom du nouveau répertoire à créer.

Merci pour votre aide.

Sub Creation_Dossiers()

Chemin = Range("R1").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Quick Kaizen EQ.1 ---
Chemin = Range("R2").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Quick Kaizen EQ.2 ---
Chemin = Range("R3").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Quick Kaizen EQ.3 ---
Chemin = Range("R4").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Quick Kaizen EQ.4 ---
Chemin = Range("R5").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Quick Kaizen EQ.5 ---
Chemin = Range("R6").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 1 EQ.1 ---
Chemin = Range("R7").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 1 EQ.2 ---
Chemin = Range("R8").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 1 EQ.3 ---
Chemin = Range("R9").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 1 EQ.4 ---
Chemin = Range("R10").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 1 EQ.5 ---
Chemin = Range("R11").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 3 EQ.1 ---
Chemin = Range("R12").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 3 EQ.2 ---
Chemin = Range("R13").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 3 EQ.3 ---
Chemin = Range("R14").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 3 EQ.4 ---
Chemin = Range("R15").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire EWO volet 3 EQ.5 ---
Chemin = Range("R16").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Avant-Après EQ.1 ---
Chemin = Range("R17").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Avant-Après EQ.2 ---
Chemin = Range("R18").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Avant-Après EQ.3 ---
Chemin = Range("R19").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Avant-Après EQ.4 ---
Chemin = Range("R20").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Avant-Après EQ.5 ---
Chemin = Range("R21").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Projet Equipe EQ.1 ---
Chemin = Range("R22").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Projet Equipe EQ.2 ---
Chemin = Range("R23").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Projet Equipe EQ.3 ---
Chemin = Range("R24").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Projet Equipe EQ.4 ---
Chemin = Range("R25").Value
MkDir (Chemin & Sheets(1).Range("S1").Value) '---nouveau répertoire Projet Equipe EQ.5 ---

End Sub

 

[jmfmarques]

Bonjour
A moins que ma vue ne me joue des tours, ceci devrait faire ce que font tes lignes de code

Dim C As Range
For Each C In Range("R6:R25").Cells
  MkDir (C.Value & Sheets(1).Range("S1").Value) 
Next

 

[patricktoulon]

jmfmarques "R1"

 

[sylvanu]

Bonjour Christ, le fil
Un essai :

Sub Creation_Dossiers()
    For i = 1 To 25
        MkDir (Range("R" & i) & Sheets(1).Range("S1"))
    Next i
End Sub

 

[christ77000]

Merci beaucoup pour votre aide, cela fonctionne très bien et surtout plus court , pour ma compréhension personnel c'est quoi la différence entre Sheets(1) et Sheets("Menu") car quand je mets Sheets("Menu") ca ne fonctionne pas.
Et je me suis rendu compte que si je clic 2 fois ca plante, certainement du au faite que les répertoires existes déjà comment palier a cela.

 

[patricktoulon]

re

Merci beaucoup pour votre aide, cela fonctionne très bien et surtout plus court , pour ma compréhension personnel c'est quoi la différence entre Sheets(1) et Sheets("Menu") car quand je mets Sheets("Menu") ca ne fonctionne pas.
Et je me suis rendu compte que si je clic 2 fois ca plante, certainement du au faite que les répertoires existes déjà comment palier a cela.

Sub Creation_Dossiers()
 dim chemin$
 with sheets(1)
    For i = 1 To 25
       chemin=.Range("R" & i) & .Range("S1")
       if dir(chemin,vbdirectory)="" then MkDir (chemin )
    Next i
end with
End Sub

 

[christ77000]

Merci beaucoup, au top

 

[jmfmarques]

Bonjour patricktoulon

Sans passer par la vérification d'attribut ? tu cours des risques dans certains cas.
Exemple ici :
un dossier "bbb" sur d:\
un fichier "aaa" dans "d:\bbb"
constate :

chemin = "d:\bbb\aaa"
  If Dir(chemin, vbDirectory) = "" Then MsgBox "ok"

OK ne sera pas affiché bien qu'aucun sous-dossier "aaa" n'existe dans le dossier "bbb"
(je crois t'en avoir parlé il y a bien longtemps .... au moins deux ans ... fouille dans ta mémoire ...)

 

[patricktoulon]

re
heu jacques

je vois très bien de quoi tu parle et de quelle discussion tu parle
mais on parle pas de fichier la on parle de dossier
et chez moi si le dossier "aaa" n'y est pas j'ai mon ok (je viens de tester pour être sur)
si tu veux on peut prendre en considération vbhidden en plus de vbdirectory mais bon

 

[jmfmarques]

tu n'as pas compris ma remarque, selon toute évidence.
Rien à voir avec l'existence d'attributs particuliers (caché, etc ...)
Relis bien mon message 8 (très attentivement)
Construis ce que j'ai exposé :
un dossier "bbb" contenant un fichier "aaa"
Il n'y a donc pas de sous-dossier "aaa" et OK devrait s'afficher. Or, il ne s'affichera pas, laissant penser à l'existence d'un dossier "aaa" (qui ne sera donc indûment pas créé).
Une autre fois : ne t'emballe pas. Prends ton temps et fais, calmement et méticuleusement, pas à pas, ce que je décris.

 

[patricktoulon]

RE
mais quelle idée d'aller foutre un fichier "aaa"sans extension!!!!! (car c'est la seule possibilité tu a de bluffer dir) un aaa avec extension ne match pas avec vbdirectory

perso les fichiers sans extension c'est poubelle chez moi sans distinction

rend toi compte

Sub test()
    chemin = "C:\Users\polux\DeskTop\bbb\aaa"
    x = Dir(chemin, vbDirectory)
    If x <> "" Then
        If (GetAttr(chemin) And vbDirectory) = vbDirectory Then
            MsgBox "pasok"
        Else
            MsgBox "ok "
        End If
    Else
        MsgBox "ok"
    End If
End Sub

et je la réduis et transforme en fonction

Sub test()
    chemin$ = "C:\Users\polux\DeskTop\bbb\aaa"
    MsgBox FolderExist(chemin)
End Sub


Function FolderExist(chemin$)
    If Dir(chemin, vbDirectory) <> "" Then If (GetAttr(chemin) And vbDirectory) <> vbDirectory Then x = False Else x = True
    FolderExist = x
End Function

 

[jmfmarques]

mais quelle idée d'aller foutre un fichier "aaa"sans extension!!!!! (car c'est la seule possibilité tu a de bluffer dir) un aaa avec extension ne match pas avec vbdirectory

perso les fichiers sans extension c'est poubelle chez moi sans distinction

J'entends bien, mais jusqu'à preuve du contraire, le destinataire final est seul à décider de ce qu'il a sur sa machine (et il a quelquefois ses raisons de ne pas permettre de connaître l'appli d'ouverture d'un fichier)

 

[patricktoulon]

d'autant plus que ca créée un problème essaie de mettre un dossier "aaa" dans "bbb" qui contient un fichier "aaa" sans extension
ben walouh terminé il te diT qu'il existe deja

allez ici aussi un gros LOL

 

[jmfmarques]

Le "problème" que tu montres ainsi du doigt n'en est un que pour ceux qui ne sont pas les propriétaires de la machine. Ces derniers (les propriétaires) y voient par contre l'opportunité de bloquer certaines manoeuvres classées comme "indésirables".
Mais c'est là un autre aspect et (une autre fois) le propriétaire d'une machine est seul à décider ceci ou cela sur sa machine, sans avoir à en rendre compte à qui que ce soit, Patrick.
Bonne continuation

 

[kiki29]

Salut, à voir si curieux