Macro pour créer un organigramme RH

Bonjour à tous,

Je veux créer une macro pour me dessiner automatiquement un organigramme RH de salariés d'une entreprise à partir d'un tableau à 3 colonnes: Nom, Poste, Manager. J'ai demandé à une IA qui m'a généré ce code mais je rencontre une erreur 438 et la macro ne traite que la première ligne. Pouvez-vous svp m'aider ? Ci-après le code

PS: je ne suis pas un pro du VBA :(

Sub CreerOrganigrammeHierarchique()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim dict As Object
Dim shape As Shape, managerShape As Shape
Dim startX As Single, startY As Single, width As Single, height As Single, space As Single
Dim nom As String, titre As String, manager As String
Dim level As Long

' Initialiser la feuille de calcul
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' Créer un dictionnaire pour stocker les formes
Set dict = CreateObject("Scripting.Dictionary")

' Définir les dimensions des formes
width = 120
height = 60
space = 20

' Supprimer les formes existantes
On Error Resume Next
ws.Shapes.SelectAll
Selection.Delete
On Error GoTo 0

' Première passe : créer toutes les formes
For i = 2 To lastRow
nom = ws.Cells(i, 1).Value
titre = ws.Cells(i, 2).Value

' Créer une forme rectangulaire
Set shape = ws.Shapes.AddShape(msoShapeRectangle, 0, 0, width, height)

' Ajouter le texte à la forme
shape.TextFrame.Characters.Text = nom & vbNewLine & titre

' Formater la forme
With shape
.TextFrame.HorizontalAlignment = xlCenter
.TextFrame.VerticalAlignment = xlCenter
.Fill.ForeColor.RGB = RGB(220, 230, 241)
.Line.ForeColor.RGB = RGB(0, 0, 0)
End With

' Ajouter la forme au dictionnaire
dict(nom) = shape
Next i

' Deuxième passe : positionner les formes et créer les connexions
startX = 50
startY = 50
For i = 2 To lastRow
nom = ws.Cells(i, 1).Value
manager = ws.Cells(i, 3).Value
Set shape = dict(nom)

' Positionner la forme
level = GetLevel(ws, nom)
shape.Left = startX + (level - 1) * (width + space)
shape.Top = startY

' Connecter au manager si existe
If manager <> "" And dict.Exists(manager) Then
Set managerShape = dict(manager)
ConnectShapes ws, managerShape, shape
End If

' Ajuster la position pour la prochaine forme
startY = startY + height + space

' Réinitialiser startY et déplacer startX si nécessaire
If startY > ws.UsedRange.Height Then
startY = 50
startX = startX + width + space
End If
Next i
End Sub

Function GetLevel(ws As Worksheet, nom As String) As Long
Dim manager As String
Dim level As Long

level = 1
manager = ws.Cells(ws.Range("A:A").Find(nom).Row, 3).Value

While manager <> ""
level = level + 1
manager = ws.Cells(ws.Range("A:A").Find(manager).Row, 3).Value
Wend

GetLevel = level
End Function

Sub ConnectShapes(ws As Worksheet, topShape As Shape, bottomShape As Shape)
Dim conn As Shape

Set conn = ws.Shapes.AddConnector(msoConnectorStraight, _
topShape.Left + topShape.Width / 2, topShape.Top + topShape.Height, _
bottomShape.Left + bottomShape.Width / 2, bottomShape.Top)

With conn.Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 1.5
End With

conn.RerouteConnections
End Sub

Edit modo : veuillez utilisez les balises de code disponibles dans le menu en cliquant sur l'icone </> lorsque vous postez une code
J'ai corrigé votre post

bonjour Benslimane,

un essai, la feuille "Tableau" on a ce tableau avec le noms des personnes et le "title" et en 3eme colonne leur "manager/chef". Ce schéma est crée pour un "directeur général". Donc si vous avez 2 ou plus, il faut créer un niveau virtuel au dessus ces 2 directeurs généraux.

La 4eme colonne sert simplement pour positioner les personnes du même chef de gauche à droit, si vous n'utilisez pas cette colonne, la macro choisit elle-même.

Maintenant vous pouvez jouer avec l'hauteur ou la largeur des colonnes vides pour améliorer le layout.

Merci beaucoup Bart pour ce code ! ça marche des feus des dieux !

Est-ce que je peux svp vous demander de rajouter une colonne qui définit la couleur de chaque ligne ? ça permettrai d'améliorer la lisibilité.

Encore 1000 merci !

re,

oui, cela est possible, maintenant en colonne A vous choissessez la coleur de la forme et de son texte.

La macro "CouleurAlea" l'a fait d'une manière aléatoire

Vous le voulez comme-ça, oubien une colonne uniquement pour ces couleurs ?

Vous pouvez aussi modifier l'hauteur des lignes sans formes, pour améliorer la lisibilité.