XL 2013 Macro Organigramme automatique

[Banjounet]

Bonjour à tous,

Je viens vers vous car je suis officiellement une bille en VBA

J'ai besoin de créer des organigrammes automatiques. Après quelques recherches j'ai trouvé le code suivant (Merci Jacques Boigontier) :

Dim colonne, débutOrg, f, forga, inth, intv, Tbl(), n
Sub DessineOrgaH()
   Set f = Sheets("OrgaBD")
   Set forga = Sheets("orgaDessin")
   Tbl = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
   n = UBound(Tbl)
   For Each s In forga.Shapes
    If s.Type = 17 Or s.Type = 1 Then s.Delete
   Next
   inth = 70
   intv = 60
   colonne = 0
   Set débutOrg = forga.Range("c4")
   créeShape Tbl(1, 1), 1, Tbl(1, 3), f.Cells(2, 1).Interior.Color
End Sub

Sub créeShape(parent, niv, Attribut, coul) ' procédure récursive
  hauteurshape = 45
  largeurshape = 70
  colonne = colonne + 1
  forga.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 1
  txt = parent & vbLf & Attribut & vbLf

  With forga.Shapes(parent)
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .Fill.ForeColor.RGB = coul
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Color = vbBlue
  End With
  forga.Shapes(parent).Left = débutOrg.Left + inth * colonne
  forga.Shapes(parent).Top = débutOrg.Top + intv * (niv - 1)
  For i = 1 To n
    If Tbl(i, 1) = parent And niv > 1 Then
      Shapepère = Tbl(i, 2)
      forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
      forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
      forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(Shapepère), 3
      forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 1
   End If
   If Tbl(i, 2) = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 3), f.Cells(i + 1, 1).Interior.Color
  Next i
End Sub

Ce code est parfait, fonctionne mais j'aimerais rajouter des colonnes au tableau de base et donc à la macro pour que dans l'organigramme des lignes supplémentaires apparaissent. Et c'est la que je n'y arrive pas…

A chaque fois que je modifie le code soit la macro ne fonctionne plus, soit les info n'apparaissent pas ou sont "écrasées" dans la bulle de l'organigramme.

J'en appel donc à votre aide !

Merci d'avance à ceux qui prendrons le temps de me lire !

En PJ le fichier avec les colonnes à rajouter ^.^

 

[Rouge]

Bonjour,

Voici

Cdlt

 

[Banjounet]

Merci beaucoup c'est top ! tu es mon sauveur !

je me permet d'abuser, tu pense que l'on peut faire apparaitre les textes "Compétences", "Evolutions"... en gras ?

 

[Rouge]

Voilà

 

[Banjounet]

Au top !

Encore un immense merci !

 

[wafa-chaouni]

Bonjour,

Pouvez vous m'aider stp,
Je veux automatiser un organigramme, j'ai le nom de l'employé et le nom de son supérieur hiérarchique,
Le fichier est ci-joint.

 

[Rouge]

Bonjour,

Ne vous greffez pas sur un post existant , créez votre propre demande.

C'est normal que cela ne fonctionne pas, il n' y a pas de logique dans l'organisation de vos données. Il faut respecter l'ordre hiérarchique sinon ce n'est pas possible.
Exemple sur les 4 premières lignes:

Poste	Superieur
ALLA JAOUAD	BABY JAAFAR
M HAMDI AHMED	HAMIMAZ ADIL
EL KALALI ELHASSANE	BAALI KHALID
KASSAOUI MOSTAFA	BAALI KHALID

1)- "ALLA JAOUAD" étant le premier de la liste, il ne doit pas avoir de supérieur.
2)- Le supérieur de "M HAMDI AHMED" devrait être "ALLA JAOUAD" et non "HAMIMAZ ADIL", idem pour les 2 autres puisque dans la même catégorie (même couleur)
Le supérieur hiérarchique doit déjà être présent en amont dans la liste.

Cdlt