Comment modifier un organigramme ?

Bonjour,

Je suis entrain de modifier un organigramme

et je veux savoir comment faire modifier l'organigramme autoamtique ustilisant un cod VBA

Alors j'ai trouvé un Code VBA sous internet , et il est comme suit :

Sub Macro1()
Dim ogSALayout As SmartArtLayout
     Dim QNode As SmartArtNode
     Dim QNodes As SmartArtNodes
     Dim t As Integer
     On Error GoTo Erreur
     Set ogSALayout = Application.SmartArtLayouts(92)
     Set ogShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout)
     Set QNodes = ogShp.SmartArt.AllNodes
     t = QNodes.Count

     While QNodes.Count = t
     QNodes(QNodes.Count).Delete
     Wend

     While QNodes.Count < Range("B3").End(xlDown).Offset(-2, 0).Row
     QNodes.Add.Promote
     Wend

For i = 3 To Range("B3").End(xlDown).Row

     While QNodes(Range("B" & i)).Level > Range("D" & i).Value
     QNodes(Range("B" & i)).Promote
     Wend

     QNodes(Range("B" & i)).TextFrame2.TextRange.Text = Range("C" & i)

     Next i

     Exit Sub
Erreur: MsgBox "Une erreur est survenue"
End Sub

le tableau est dans le fichier excel ci-joint. :

et le résultat est comme suit :

image

ce que je veux, est ce que c'est possible de modifier le code VBA pour me donner le résultat suivant :

screen shot 2022 10 09 at 7 52 00 pm

en ajoutant deux cellule sur la gauche, ces deux cellule concernant la column E et F

j'espère vous me trouverez une solution

Rechercher des sujets similaires à "comment modifier organigramme"