[ NON RESOLU] Hierarchie selon plusieurs critères

[Vilain]

Salut à tous,

Je fais appel à vous car je ne sais pas par quel bout prendre ce nouveau problème.
Je m'explique.
J'ai 3 colonnes :
-le nom du salarié
-son grade
-son chef

Je souhaiterai créer quelque chose qui ressemble à un organigramme tout en tenant compte du grade.
Je joins mon fichier exemple avec ce que je souhaite obtenir sur la droite.
N'hésitez pas à me demander des informations complémentaires si besoin.

Merci d'avance et à plus.

 

[Habitude]

Re : [ NON RESOLU] Hierarchie selon plusieurs critères

Pour régler un problème de positionnement lors d'un saut de plusieurs niveau

 

[BOISGONTIER]

Re : [ NON RESOLU] Hierarchie selon plusieurs critères

Bonjour,

Voir PJ

http://boisgontierjacques.free.fr/fichiers/jb-organigramme.xls

Dim bdt, n, colonne, débutOrg, f
Sub organigramme()
  Set f = Sheets("organigramme")
  creeShapes
  Set débutOrg = f.Range("E16")
  débutOrg.Resize(5, 20).ClearContents
  EffaceTrait
  colonne = 0
  n = Application.CountA(Range("a:a")) - 1
  bdt = Range("BD").Value
  vpersonnesPhoto f.Range("A2"), 1
End Sub

Sub vpersonnesPhoto(parent, niv)                ' procédure récursive
  colonne = colonne + 1
  f.Shapes(parent).Top = débutOrg.Offset(niv, colonne).Top + 2
  f.Shapes(parent).Left = débutOrg.Offset(niv, colonne).Left + 6
  For i = 2 To n
      If UCase(bdt(i, 1)) = UCase(parent) Then
        shapePère = bdt(i, 3)
        f.Shapes.AddConnector(msoConnectorElbow, 813.75, 258.75, 885.75, 330.75).Select
        Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes(shapePère), 3
        Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes(parent), 1
      End If
  Next i
  For i = 2 To n
    If UCase(bdt(i, 3)) = UCase(parent) Then vpersonnesPhoto bdt(i, 1), niv + 1
  Next i
End Sub

JB