@patricktoulon
Pourquoi faire compliqué quand on peut faire simple?
Excel offre en natif un large choix d'organigramme
(personnalisable à souhait facilement par le ruban)
C'est d'ailleurs sur le SmartArt que le demandeur avait porté son choix (cf message#1)
Quel intérêt ne pas utiliser les nouvelles fonctionnalités offertes dans les nouvelles versions d'Excel ?
@halecs93
Même si le demandeur semble ignorer mes messages, je persiste
Le code VBA dans la PJ du message#1 fonctionne si on respecte ce que j'évoquais en message#10
Pour s'en convaincre
Lancer cette macro sur une feuille vierge
VB:
Sub creer_test()
[B3] = 1: [B3:B14].DataSeries
[C3:C14].FormulaR1C1 = "=""NOM ""&ROW()-2&"" Prénom""&ROW()-2"
[D3:D14] = Application.Transpose(Split("1u2u3u3u4u2u3u3u4u2u3u2", "u"))
End Sub
Puis lancer la macro de création de l'organigramme.
(je la remets ici par commodité)
VB:
Sub orga()
Dim ogSALayout As SmartArtLayout, QNode As SmartArtNode, QNodes As SmartArtNodes, t%
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
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
Exit Sub
Erreur: MsgBox "Une erreur est survenue"
End Sub
Résultat: J'obtiens un organigramme
Je n'ai donc pas de message d'erreur, ce qui était la question initiale, non ?
Et pour ce faire, j'ai simplement suivi le tuto (la vidéo) à la lettre
L'avantage de passer par SmartArt, c'est qu'on bénéficie ensuite des options de mise en forme offertes nativement par Excel.
(pas besoin de réinventer la roue, n'est-ce pas @patricktoulon)
@halecs93
Content de le savoir
Mais comme je n'ai pas lu de ta part si tu avais encore ou pas le message d'erreur, je pensais que tu avais zappé mes messages.
Tu as fait le test proposé dans le message#14 ?
Test OK chez moi, sans message d'erreur
(Excel 365 + W10)
@patricktoulon
Moi, non plus je ne connais pas plus que cela les SmartArt
Simplement, comme disait Jean-Claude Convenant, j'essaie d'utiliser les fonctions natives d'Excel autant que faire se peut
Et je conseille (quand la fièvre du principe KISS me reprend) aux primo-utilisateurs d'Excel de faire de même
@halecs93
Même si le demandeur semble ignorer mes messages, je persiste
Le code VBA dans la PJ du message#1 fonctionne si on respecte ce que j'évoquais en message#10
Pour s'en convaincre
Lancer cette macro sur une feuille vierge
VB:
Sub creer_test()
[B3] = 1: [B3:B14].DataSeries
[C3:C14].FormulaR1C1 = "=""NOM ""&ROW()-2&"" Prénom""&ROW()-2"
[D3:D14] = Application.Transpose(Split("1u2u3u3u4u2u3u3u4u2u3u2", "u"))
End Sub
Puis lancer la macro de création de l'organigramme.
(je la remets ici par commodité)
VB:
Sub orga()
Dim ogSALayout As SmartArtLayout, QNode As SmartArtNode, QNodes As SmartArtNodes, t%
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
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
Exit Sub
Erreur: MsgBox "Une erreur est survenue"
End Sub
Résultat: J'obtiens un organigramme
Je n'ai donc pas de message d'erreur, ce qui était la question initiale, non ?
Et pour ce faire, j'ai simplement suivi le tuto (la vidéo) à la lettre
L'avantage de passer par SmartArt, c'est qu'on bénéficie ensuite des options de mise en forme offertes nativement par Excel.
(pas besoin de réinventer la roue, n'est-ce pas @patricktoulon)
En effet, cela fonctionne. Souci... l'organigramme créé est horizontal (et illisible) alors que je souhaiterais l'obtenir en vertical. Et question subsidiaire, la taille des smatsarts peut-elle être adaptée au contenu ?
@halecs93
Pour ma part dans un premier temps, je me suis borné à résoudre la question du message#1
A savoir: faire disparaitre le message d'erreur.
C'est désormais chose faite
En investiguant un peu plus, tu peux déjà faire des tests en te basant sur les valeurs suivantes.
(En remplaçant 92 par une des valeurs suivantes dans cette ligne de code) Set ogSALayout = Application.SmartArtLayouts(92)
@halecs93
Si tu veux mettre en forme l'organigramme une fois qu'il est généré, tu peux tester cette macro
VB:
Sub Mise_en_forme_ORGA()
Dim shp As Shape
Application.ScreenUpdating = False
With ActiveSheet
With .Shapes(1)
.Height = 500: .Width = 1200: .Top = 7: .Left = 13
End With
For Each shp In .Shapes
shp.SmartArt.Color = Application.SmartArtColors(8) 'valeurs possibles: 1 à 38
shp.SmartArt.QuickStyle = Application.SmartArtQuickStyles(8) ''valeurs possibles: 1 à 14
Next
End With
End Sub
@halecs93
Si tu veux mettre en forme l'organigramme une fois qu'il est généré, tu peux tester cette macro
VB:
Sub Mise_en_forme_ORGA()
Dim shp As Shape
Application.ScreenUpdating = False
With ActiveSheet
With .Shapes(1)
.Height = 500: .Width = 1200: .Top = 7: .Left = 13
End With
For Each shp In .Shapes
shp.SmartArt.Color = Application.SmartArtColors(8) 'valeurs possibles: 1 à 38
shp.SmartArt.QuickStyle = Application.SmartArtQuickStyles(8) ''valeurs possibles: 1 à 14
Next
End With
End Sub