Comment modifier un organigramme ?
k
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 Suble tableau est dans le fichier excel ci-joint. :
et le résultat est comme suit :
ce que je veux, est ce que c'est possible de modifier le code VBA pour me donner le résultat suivant :
en ajoutant deux cellule sur la gauche, ces deux cellule concernant la column E et F
j'espère vous me trouverez une solution