Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Macro Organigramme automatique

Banjounet

XLDnaute Nouveau
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) :

VB:
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 ^.^
 

Pièces jointes

  • YALEFEU.xlsm
    28.3 KB · Affichages: 67

wafa-chaouni

XLDnaute Nouveau
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.
 

Pièces jointes

  • Banjounet_Macro Organigramme automatique.xlsm
    58 KB · Affichages: 36

Rouge

XLDnaute Impliqué
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:
PosteSuperieur
ALLA JAOUADBABY JAAFAR
M HAMDI AHMEDHAMIMAZ ADIL
EL KALALI ELHASSANEBAALI KHALID
KASSAOUI MOSTAFABAALI 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
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…