Fonction "MkDir" avec création de sous-dossier

re le forum

Mike2106 a écrit :

Pourquoi il ne veut pas créer les dossiers ?

La macro ne crée pas de répertoires, elle ne fait qu'enregistrer

le fichier dans les répertoires déjà manuellement crées.

Une version automatisée avec création des répertoires :

Mytå

Re,

La macro ne crée pas de répertoires, elle ne fait qu'enregistrer

Ben oui Myta, c'est ce que j'ai déjà dit avant.

Mike, vois le fichier ci-joint testé sous excel 2010

Amicalement

Bonsoir,

Nous avons dû mal nous comprendre depuis le début je pense avec Dan. Ce que tu as crée Myta est exactement ce que j'avais imaginé. C'est-à-dire la création de répertoire automatisé. Avec la version que tu as mis au point nous avons la création du répertoire année. Je souhaitais en fait qu'il y ait surtout la création du répertoire classe contenant le répertoire de chaque élève. Car le répertoire année n'est crée qu'une seule fois. A l'intérieur se trouve le répertoire de chaque classe (j'en ai 18). Et à l'intérieur de chaque classe se trouve le répertoire de chaque élève (j'en ai 30 par classe). Ce qui veut dire qu'il y a une arborescence qui se constitue ainsi pour l'exemple de l'élève Ron Howard de 3A de l'année 2012-2013 :

D:\TRAVAIL\2012-2013\3A\Howard Ron

Voilà, j'espère que j'ai éclairci un peu la situation.

A+

Re le forum

Remplace les macros par

Sub Archiver()
    'Macro par Dan pour Mike2106 - le 30/10/2011
    'Modifié par Mytå pour création des répertoires - le 2011-11-09
    Dim annee As String, classe As String, nomfichier As String, chemin As String
    Dim Ligne As Byte

     With Sheets("Liste_élève")
      If IsEmpty(.Range("E2")) Or IsEmpty(.Range("i2")) Or IsEmpty(.Range("d4")) Then _
        MsgBox "Certaines cellules ne sont pas renseignées !": Exit Sub
        annee = .Range("E2")
        classe = .Range("I2")
        chemin = "D:\Travail\" & annee & "\" & classe & "\"
         For Ligne = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
          MakeDirEx (chemin & .Cells(Ligne, 4) & " " & .Cells(Ligne, 5))
         Next Ligne
     End With

    MsgBox "Traitement terminé !"

End Sub

'**********************************************************************
'* Crée un répertoire et ses répertoires parents s'ils n'existent pas *
'**********************************************************************
Function MakeDirEx(DirPath$) As Boolean
Dim i%, tmp, Arr

  If InStr(1, DirPath, ":") = 0 Then
    Arr = Split(CurDir & "\" & DirPath, "\")
  Else: Arr = Split(DirPath, "\")
  End If

  tmp = Arr(0)
  For i = LBound(Arr) + 1 To UBound(Arr)
    If Arr(i) <> "" Then
      tmp = tmp & "\" & Arr(i)
      On Error Resume Next
      MkDir tmp
      On Error GoTo 0
    End If
  Next

  If Dir(DirPath, vbDirectory) = "" Then
    On Error Resume Next
    RmDir Arr(0) & "\" & Arr(1)
    On Error GoTo 0
  Else
    MakeDirEx = True
  End If

End Function

Mytå

Re,

Génial !!!!!!!!!!! J'ai fais un petit test et ça marche !!!!

Je teste demain sur plus gros format et je poste l'ensemble pour que cet outil serve à ceux qui veulent travailler avec ce type de fichier. Dans me profession cet outil devient du coup vraiment très utile. Enfin si ça ne te dérange pas Myta ? Merci à toi et merci à Dan aussi de s'être autant investit. J'ai d'ailleurs compris pas mal de truc grâce à lui. C'est juste qu'on ne réfléchissait pas sur la même chose.

Je teste et je vous tiens au courant.

A+

re le forum

Mike, tu peux utiliser le code sans problèmem il est libre de droit pour minime participation

Une dernière petite formalité pour ta question, ne pas oublier de le faire passer en [Résolu]

Mytå

Re,

Je tiens à remercier chaleureusement Dan et Myta pour avoir crée les codes nécessaires à l'utilisation des fichiers que j'ai mis ici en pièce jointe afin qu'ils soient utilisables par tout les enseignants travaillant avec l'évaluation par compétence et conservant des traces numériques des travaux d'élèves. Dans le document se trouve un fichier par niveau (6ème, 5ème, 4ème, 3ème) avec un mode d'emploi détaillé. La version d'Excel est celle d'office 2007.

Les compétences concernent ici les arts plastiques, mais le contenu est modifiable à volonté et le document peut ainsi être transposé dans toutes les matières enseignés.

Je tenais à partager ce travail car il est, je pense, une somme d'outils particulièrement efficaces dans le travail quotidien de l'enseignant.

Merci à Excel-pratique d'être aussi "pratique" et d'avoir des membres aussi compétent et prêt à aider même les plus incompétents, pour ne pas dire noob, à se retrouver dans l'univers au combien nébuleux d'Excel.

A bientôt,

Mike, professeur d'arts plastiques en collège

Héhé, j'ai oublié de cliquer sur résolu...Noob un jour, noob toujours...