Lecture de cellule vide

tchangy71

XLDnaute Occasionnel
Bonjour,
Voila je souhaite créer des dossiers suivant le textes inscrit dans différente cellules.

Je maitrise plus ou moins bien la fonction "Mkdir", mais j'ai un problème quant à la lecture de mes cellules !

Je joins le fichier excel pour compléter mes questions.

exemple :

Il s'agit d'un tableau permettant la création, a partir de cellule excel, d'une arborescence de répertoire correspondant.

J'ai un nom en cellule "C1" (correspondant au nom de mon client)

En cellule "B5" j'ai mon premier groupe appartenant à ce même client
(fusion de la cellule "B5" à "B13")
En cellule "C6" j'ai mon premier lieu appartenant au groupe ("B5")
(fusion de la cellule "C6" à "C9")
En cellule "G7" j'ai mon premier sous lieu appartenant au lieu ("C6")
En cellule "G8" j'ai mon 2ème sous lieu appartenant au lieu ("C6")
En cellule "G9" j'ai mon 3ème sous lieu appartenant au lieu ("C6")

En cellule "B14" j'ai mon deuxième lieu appartenant au groupe ("B5")
En cellule "B22" le 3ème et etc.
En sachant que le numéro de ligne est "variable" et ne sera jamais le même en fonction des clients.

Comment faire pour créer l'arborescence de fichier correspondant à l'arborescence de ma feuille ?

Merci d'avance,
Philippe
 

Pièces jointes

  • Création_arborescence_bon - Copie.xlsm
    23.9 KB · Affichages: 35

PMO2

XLDnaute Accro
Re : Lecture de cellule vide

Bon jour,

Une piste avec le code suivant à copier dans un module standard

Code:
'### Constante à adapter ###
Const Racine As String = "C:\"
'###########################

Sub Arborescence()
Dim S As Worksheet
Dim var
Dim i&
Dim j&
Dim k&
Dim A$
Dim B$
Dim C$
Dim D$
Set S = ActiveSheet
var = S.Range("a1:g" & S.[g65536].End(xlUp).Row & "")
A$ = Racine & var(1, 3)
On Error Resume Next
MkDir A$
If Err <> 0 Then
  If Err = 75 Then
    MsgBox "Le dossier " & A$ & " existe déjà"
  Else
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
  End If
  Exit Sub
End If
On Error GoTo 0
For i& = 5 To UBound(var, 1)
  If var(i&, 2) <> "" Then
    B$ = A$ & "\" & var(i&, 2)
    MkDir B$
    For j& = i& + 1 To UBound(var, 1)
      If var(j&, 2) <> "" Then Exit For
      If var(j&, 4) <> "" Then
        C$ = B$ & "\" & var(j&, 4)
        MkDir C$
        For k& = j& + 1 To UBound(var, 1)
          If var(k&, 4) <> "" Then Exit For
          If var(k&, 7) <> "" Then
            D$ = C$ & "\" & var(k&, 7)
            MkDir D$
          End If
        Next k&
      End If
    Next j&
  End If
Next i&
End Sub

J'ai programmé sous Excel2003 n'ayant pas de version Excel plus récente.

Cordialement.

PMO
Patrick Morange
 

Discussions similaires

Statistiques des forums

Discussions
299 878
Messages
1 979 751
Membres
206 857
dernier inscrit
Pageee