Lecture de cellule vide

[tchangy71]

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

 

[PMO2]

Re : Lecture de cellule vide

Bon jour,

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

'### 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