Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

newbie64

XLDnaute Nouveau
Bonjour à toutes et à tous,

J'espère que mon mot vous trouve en bonne santé!

J'aurai besoin de votre appui. Je travaille sur une macro pour générer un organigramme via des données entrées dans un tableau Excel. Il fonctionne bien. Néanmoins, je souhaite le rendre plus facile d'utilisation pour mes collègues et rajouter une fonctionnalité.

Actuellement, il ne me propose que les liens hiérarchiques.

Ma demande est la suivant (Bouteille à la mer 😉 ) : auriez-vous une proposition à intégrer au code qui permettrait de rajouter les liens fonctionnels également ? Si pas possible avec ce code, je suis ouverte à changer la macro.

Sub Macro6()
Dim ogSALayout As SmartArtLayout
Dim QNode As SmartArtNode
Dim QNodes As SmartArtNodes
Dim t As Integer
Set ogSALayout = Application.SmartArtLayouts(92) 'reference to organization chart
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

For i = 3 To Range("B3").End(xlDown).Row
While QNodes(Range("B" & i)).Level < Range("D" & i).Value
QNodes(Range("B" & i)).Demote
Wend

Next i

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
332
Réponses
6
Affichages
522
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
481
Réponses
2
Affichages
371
Réponses
3
Affichages
485
Réponses
3
Affichages
449
Réponses
2
Affichages
691
Retour