XL 2016 positions de shapes dans un organigramme créé par VBA

[halecs93]

Bonjour à tout le monde.

Je poursuis mes lentes avancées afin de finaliser mon classeur.

Je n'arrive pas à caler correctement les espaces entre les shapes. Une image valant souvent mieux qu'un long discours, je la publie (ainsi que le classeur anonymisé)


Merci à tout le monde

 

[Zon]

Bonjour,

Cela fait longtemps que je ne suis venu sur le forum, mais je pense que les règles sont les mêmes .

Ta demande est certes explicite, toutefois, c'est un peu le footoir dans ton code ....

Je pense que ton problème vient de là puis c'est au moment de la création du rectangle qu'on définit sa position.

Set shap = Sheets("ORGANIGRAMME").Shapes.AddShape(msoShapeRoundedRectangle, L2, T, larg, haut)

c'est ici que cela doit se jouer les propriétés left et Top Donc tes variables L2 et T.

Réponds moi sur ce forum si tu veux je cherche plus en profondeur ....

A+++

 

[halecs93]

Bonjour,

Cela fait longtemps que je ne suis venu sur le forum, mais je pense que les règles sont les mêmes .

Ta demande est certes explicite, toutefois, c'est un peu le footoir dans ton code ....

Je pense que ton problème vient de là puis c'est au moment de la création du rectangle qu'on définit sa position.

Set shap = Sheets("ORGANIGRAMME").Shapes.AddShape(msoShapeRoundedRectangle, L2, T, larg, haut)

c'est ici que cela doit se jouer les propriétés left et Top Donc tes variables L2 et T.

Réponds moi sur ce forum si tu veux je cherche plus en profondeur ....

A+++

Bonjour... un peu foutoir, je n'en doute pas. Code construit petit à petit sans maîtrise du VBA.... mais en tâtonnant, faisant des tests, glanant les conseils ici...

Et donc oui, je suis preneur de tout conseil

Merci

 

[Zon]

Bonjour,

je regarde cela pour Lundi.

 

[Staple1600]

Bonjour le fil

@halecs93
Donc tu n'utilises plus les SmartArt
Alors que c'était ton choix dans ta 1ère discussion

XL 2019 - organigramme en VBA

Bonjour à toutes et à tous, J'ai tenté un code VBA afin de créer automatiquement un organigramme hiérarchique (utilisant SmartArt). Je rencontre une erreur à l'instruction : QNodes(Range("B" & i)).Demote Quelqu'un(e) aurait une idée pour me sortir de cette impasse ? Merci beaucoup

excel-downloads.com

Avec l'avantage de formatage offert par les SmartArt
(voir ci-dessous)

 

[halecs93]

Bonjour le fil

@halecs93
Donc tu n'utilises plus les SmartArt
Alors que c'était ton choix dans ta 1ère discussion

XL 2019 - organigramme en VBA

Bonjour à toutes et à tous, J'ai tenté un code VBA afin de créer automatiquement un organigramme hiérarchique (utilisant SmartArt). Je rencontre une erreur à l'instruction : QNodes(Range("B" & i)).Demote Quelqu'un(e) aurait une idée pour me sortir de cette impasse ? Merci beaucoup

excel-downloads.com

Avec l'avantage de formatage offert par les SmartArt
(voir ci-dessous)
Regarde la pièce jointe 1173322

Je n'arrivais à rien... j'ai tenté, en effet, une autre approche....moins belle visuellement...

 

[Staple1600]

Re

@halecs93
J'ai une autre macro en stock (glanée) sur le net et utilisant les SmartArt
• Intéressé ? (*)

NB: je ne vais me replonger dedans (je parle des SmartArt), si au final tu changes encore ton fusil d'épaule

(*) Exemple du résultat produit par la macro que j'évoque
On part des données en colonne A

©

 

[halecs93]

Re

@halecs93
J'ai une autre macro en stock (glanée) sur le net et utilisant les SmartArt
• Intéressé ? (*)

NB: je ne vais me replonger dedans (je parle des SmartArt), si au final tu changes encore ton fusil d'épaule

(*) Exemple du résultat produit par la macro que j'évoque
On part des données en colonne A
Regarde la pièce jointe 1173345
©

Ho merci.... je vais regarder ça... si le lien est dispo

 

[Staple1600]

Re

J'attends d'abord de savoir si cette fois tu restes sur les SmartArt
(Ce que tu n'as fait suite à mon intervention dans ton 1er fil)
Comme je l'ai dit, je ne vais passer N minutes dans mon VBE à jour avec les SmartArt si au final, tu prends une autre voie comme celle de ta macro dans le PJ du 1er message.

 

[halecs93]

Re

J'attends d'abord de savoir si cette fois tu restes sur les SmartArt
(Ce que tu n'as fait suite à mon intervention dans ton 1er fil)
Comme je l'ai dit, je ne vais passer N minutes dans mon VBE à jour avec les SmartArt si au final, tu prends une autre voie comme celle de ta macro dans le PJ du 1er message.

Je demandais juste à voir le fichier et son code VBA... pour le travailler au cas où.... c'est toujours intéressant de se nourrir de ce qui existe déjà

 

[Staple1600]

Re

@halecs93

Non, je demandais juste à voir le fichier et son code VBA.

C'est ce que j'ai fait ici, non ?

XL 2019 - organigramme en VBA

Bonjour à toutes et à tous, J'ai tenté un code VBA afin de créer automatiquement un organigramme hiérarchique (utilisant SmartArt). Je rencontre une erreur à l'instruction : QNodes(Range("B" & i)).Demote Quelqu'un(e) aurait une idée pour me sortir de cette impasse ? Merci beaucoup

excel-downloads.com

1) Pas eu de commentaires sur tes tests de mon code
2) Ce code n'est pas présent dans la PJ du message de cette discussion.

Donc je suis pas très chaud à passer du temps sur une question, si le demandeur change son fusil d'épaule en cours de route.

Attendons lundi, le retour de @Zon et sa proposition basée sur ton nouveau code (sans SmartArt)

 

[Zon]

Salut le forum, Staple1600 et Halmecs 93


Tout d'abord un grand merci à Staple1600 pour le respect que tu m'accordes en attendant ma réponse ( ce qui n'était plus forcément le cas y a quelques années..) de laisser ta porte ouverte à Halecs93 pour lui apporter quand même ton aide.

Même si je ne suis pas modérateur du site et en tant que vieux contributeur du forum , cela fait plus de 21 ans que j'ai commencé sur XLD, Halecs93 je te mets gentiment un carton jaune avec une amende de 2 bières pour les contributeurs du fil que tu as ouvert sur les smartArt. Il eût fallu que tu répondisses même si cela te convenait pas.


1 ère question:
Halecs93, tu fixes la position gauche de père avec L1 soit 250 dans ton code quelque soit le nombre d'enfants.

On sait que le coté droit du 1 er enfant est en 235 , puis le 2eme en 478 (soit 243 d'écart) , le n eme en 235+243*n ..

Pour trouver le milieu de la distance du connecteur j'ai pas trouvé mieux que faire la différence entre la droite du dernier enfant et le 1 er enfant , ce qui donne en factorisant (nbshape enfants-1 *243 )-8)/2

Testes an rajoutant cette fonction

Function NbshapeS(Plage As Range, NumCol As Integer) As Integer
   NbshapeS = WorksheetFunction.CountIf(Plage, NumCol)
End Function

Pere tu peux le définir ainsi en début de ton code (je remplace L1)

  Set pere = Sheets("ORGANIGRAMME").Shapes.AddShape(msoShapeRoundedRectangle, (((NbshapeS(r.Columns(3), 2) - 1) * 243) - 8) / 2, T, larg, haut)

2eme question; testes la 1ere question d'abord, sinon pourquoi définir en dur un écart de 4 cm (ta variable T2) si tu veux mettre plus ???


A+++

 

[halecs93]

Salut le forum, Staple1600 et Halmecs 93


Tout d'abord un grand merci à Staple1600 pour le respect que tu m'accordes en attendant ma réponse ( ce qui n'était plus forcément le cas y a quelques années..) de laisser ta porte ouverte à Halecs93 pour lui apporter quand même ton aide.

Même si je ne suis pas modérateur du site et en tant que vieux contributeur du forum , cela fait plus de 21 ans que j'ai commencé sur XLD, Halecs93 je te mets gentiment un carton jaune avec une amende de 2 bières pour les contributeurs du fil que tu as ouvert sur les smartArt. Il eût fallu que tu répondisses même si cela te convenait pas.


1 ère question:
Halecs93, tu fixes la position gauche de père avec L1 soit 250 dans ton code quelque soit le nombre d'enfants.

On sait que le coté droit du 1 er enfant est en 235 , puis le 2eme en 478 (soit 243 d'écart) , le n eme en 235+243*n ..

Pour trouver le milieu de la distance du connecteur j'ai pas trouvé mieux que faire la différence entre la droite du dernier enfant et le 1 er enfant , ce qui donne en factorisant (nbshape enfants-1 *243 )-8)/2

Testes an rajoutant cette fonction

Function NbshapeS(Plage As Range, NumCol As Integer) As Integer
   NbshapeS = WorksheetFunction.CountIf(Plage, NumCol)
End Function

Pere tu peux le définir ainsi en début de ton code (je remplace L1)

  Set pere = Sheets("ORGANIGRAMME").Shapes.AddShape(msoShapeRoundedRectangle, (((NbshapeS(r.Columns(3), 2) - 1) * 243) - 8) / 2, T, larg, haut)

2eme question; testes la 1ere question d'abord, sinon pourquoi définir en dur un écart de 4 cm (ta variable T2) si tu veux mettre plus ???


A+++

Bonjour et merci pour cette première réponse. En modifiant le code, en effet, le 'pere' est bien centré horizontalement.

En ce qui concerne la deuxième question (écart de 4 cm), c'est pour éviter que mon éventuel 5e niveau chevauche un autre shape (voir illustration).

 

[Zon]

Salut,

Dans la partie ' Les enfants étage(2) en augmentant la valeur de L2 on augmente l'écartement entre les shapes
en passant de 1 à 1.5 ça passe.

L2 = L2 + larg + ecart
L2 = L2 + Application.CentimetersToPoints(1.5)

Cette méthode convertit des centimètres en points (un point est égal à 0,035 centimètres).


Est ce que pour la suite de ton projet tu vas avoir plus de 5 niveaux ?



A+++

 

[halecs93]

Salut,

Dans la partie ' Les enfants étage(2) en augmentant la valeur de L2 on augmente l'écartement entre les shapes
en passant de 1 à 1.5 ça passe.

L2 = L2 + larg + ecart
L2 = L2 + Application.CentimetersToPoints(1.5)

Cette méthode convertit des centimètres en points (un point est égal à 0,035 centimètres).


Est ce que pour la suite de ton projet tu vas avoir plus de 5 niveaux ?



A+++

Bonjour, et encore merci.

Pour le moment, 5 niveaux me semble déjà suffire.

En tout cas, ce la fonctionne là.

Reste à me pencher sur les SmartArts maintenant