XL 2013 ajouter les shapes de connection pseudo organigramme style tree view

[patricktoulon]

Bonjour a tous
je suis tomber sur un sujet qui m'a interpellé qui parlais d'organigrame
jusque là rien de bien compliqué
perso j'ai ma propre méthode qui me convient tres bien et affiche les chape facon treeview (indenté)
je cherche a ajouter les connecteur
dans la boucle je le shape mère et le shap enfant sont clairement identifiés
mais impossible de faire des connecteur en angle droit (ajustement beginconnection etc... rien n'y fait j'ai toujours ces espèces de Z

je souhaiterais obtenir ceci

c'est après cette ligne que ca doit se placer
If parentshap.Name <> "" Then
le code en entier

Sub clearshapes()
    For Each shap In Feuil2.Shapes
        shap.Delete
    Next
End Sub


Sub CreateOrgaTreeview()

    Dim oXML As Object, oNode(), plage As Range, connector As Shape
    clearshapes
    Set plage = Feuil1.Range("A2:C" & Feuil1.Cells(Rows.Count, 1).End(xlUp).Row)
    ReDim oNode(1 To plage.Rows.Count)
    Set oXML = CreateObject("MSXML2.DOMDocument")
    Set rang = oXML.appendchild(oXML.createelement("organigrame"))

    For i = 1 To plage.Rows.Count
        Set oNode(i) = oXML.createelement(Replace(plage.Cells(i, 1).Value, " ", "_"))
        oNode(i).setattribute "parent", Replace(plage.Cells(i, 2), " ", "_")
        oNode(i).setattribute "poste", Replace(plage.Cells(i, 3), "/", "|")
        rang.appendchild (oNode(i))
    Next
    oXML.Save (Environ("userprofile") & "\Desktop\etape1.xml")

    For i = 1 To UBound(oNode)
        Set parnt = oXML.getelementsbytagname(oNode(i).getattribute("parent"))(0)
        parnt.appendchild (oNode(i))
    Next
    oXML.Save (Environ("userprofile") & "\Desktop\etape2.xml")

    Set elements = oXML.getelementsbytagname("*")
    t = 10
    For Each elem In elements
        If elem.getattribute("parent") <> "organigrame" Then
            Set shap = Feuil2.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 10, 10, 150, 30)
            shap.Top = t
            shap.Name = Replace(elem.tagname, "_", " ")
            Set parentshap = Feuil2.Shapes(Replace(elem.getattribute("parent"), "_", " "))
            With shap
                .Left = parentshap.Left + 50
                .TextFrame.Characters.Text = .Name & vbCrLf & Replace(elem.getattribute("poste"), "|", "/")
                .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
                .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
                .TextFrame.Characters(Start:=1, Length:=Len(.Name)).Font.Bold = True
                .TextFrame.Characters(Start:=1, Length:=Len(.Name)).Font.ColorIndex = 3
                .Fill.ForeColor.RGB = RGB(255, 255, 200)

            End With


            t = t + 35
            If parentshap.Name <> "" Then
                'c'est ici
                Set connector = Feuil2.Shapes.AddConnector(msoConnectorElbow, parentshap.Left, parentshap.Top, 50, shap.Top - parentshap.Top)
                connector.Name = shap.Name & "c"
                connector.Line.Visible = True
                connector.Line.ForeColor.RGB = vbBlack

                connector.Adjustments.Item(1) = 0

                'connector.ConnectorFormat.BeginConnect parentshap, 3'plante sur 2013
                'connector.ConnectorFormat.EndConnect shap, 1'plante sur 2013
                Debug.Print shap.Name & " parent= " & parentshap.Name
            End If
        End If

    Next
End Sub

comme vous le voyez le parent et l'enfant sont bien identifié dans la console

 

[patricktoulon]

re
obligé de partir en inter reviens dans une heure

 

[patricktoulon]

Bonjour
Bon me voilà arriver un peu plus loin que prévu
en effet suggéré par @Staple1600 j'ai rendu mon organigramme style treeview interactif
celà veut dire qu'il fonctionne comme un treeview

j'ai juste un petit problème l'or du developpe ou undeveloppe d'un item et ses enfant

au départ a la construction tout est développé et les connecteurs sont bien placés
mais quand je réduis je n'arrive pas a trouver la properties qui me permettrais de remettre le endconnect a jour avec les coordonnées x y de fin

quand je le construit c'est simple

Set connector = Feuil2.Shapes.AddConnector(msoConnectorElbow, BeginX , BeginY , EndX , EndY)

donc ca donne ca

 Set connector = Feuil2.Shapes.AddConnector(msoConnectorElbow, ParentShap.Left + 10, ParentShap.Top + ParentShap.Height, shap.Left, shap.Top + (shap.Height / 2))

mais pour le modifier comment fait -on ????
l'argument"endX et endY" n'existe pas je suppose?????

with shapes("connecteur1")
.left=parentshap.left+10
.top=parentshap.top+parentshape.height
'.EndX=???????????????????
'.EndY=....???????????????
end with

pour l'exemple
deux shapes raccordé par le connecteur et je remonte un peu la shapes(2)
le connecteur doit suivre

Sub test()

    Set feuille = Feuil3
    Set s = feuille.Shapes
    
    Set ParentShap = s.AddShape(msoShapeRectangle, 50, 50, 100, 50)
    Set shap = s.AddShape(msoShapeRectangle, 100, 250, 100, 50)
    Set connector = s.AddConnector(msoConnectorElbow, ParentShap.Left + 10, ParentShap.Top + ParentShap.Height, shap.Left, shap.Top + (shap.Height / 2))
    connector.Adjustments.Item(1) = 0
shap.Top = shap.Top - 80
End Sub

 

[patricktoulon]

re
Bonjour a tous
c'est bon
a force de tests et de crise de nerfs j'ai fini par comprendre comment fonctionnaient les connecteurs
alors c'est pas simple surtout que le but est de pourvoir bouger les shapes connectées entre elles
en effet le beginconnect et le endconnect n'ont que 2 arguments
le (shape pere et fils )et le coté de la connexion (1,2,3 ou4)
quand on utilise seulement ces deux là on peut déplacer les shapes connectées le connecteur suit

mais si on veux démarrer la connexion a un autre endroit sur un des cotés on utilise incrémente(left,top) sauf que là le beginconnect est perdu le connecteur se déplacera avec la shape(enfant(du endconnect)) connectée mais le père est déconnecté
il faut donc malheureusement pour replacer le connecteur
reconnecter avec begin et end -->(connect) et re incrémenter

conclusion mon treeview avec shape fonctionne à merveille

c'est @Staple1600 qui va être content c'est de sa faute c'est lui qui m'a donnée l'idée

donc voila la bête
je rappelle que pour la construction j'utilise un MAP avec xmldomdocument en mémoire
ce MAP sert juste à pour remettre en ordre hiérarchique le tableau( au cas ou les lignes seraient dans le désordre ) et ça me permet donc de démarrer la construction dans l'ordre

je mémorise les enfants directs dans une ligne dans le alternativetext
je mémorise les descendants(enfant et sub enfants) dans une autre ligne du alternativetext
ce texte me servira l'ors du click sur les shapes de developper ou Undevelopper

démonstration du final et bien sur le fichier joint

 

[Staple1600]

Bonsoir le fil

c'est @Staple1600 qui va être content c'est de sa faute c'est lui qui m'a donnée l'idée

Moi, je suis content
1) quand ma pizza est bien cuite et ma bière bien fraiche
2) et je n'oublie pas mon mantra: le K.I.S.S
(Ce qui donc si j'étais moi , fait que je caresse ma souris avant tout )

NB: Mais j'avais raison, tu as résolu quasiment seul(*) ta question
(Un bout de JB par là, un bout de p56 par ici, et une petite suggestion de myself)

 

[patricktoulon]

re
bonsoir @Staple1600

(Un bout de JB par là, un bout de p56 par ici, et une petite suggestion de myself)

je le dis par ce que j'y tiens
il n'y a rien de JB ou p56
seule la suggestion pour le alternativetext est de jp56 comme mémoire mais la construction n'est que de moi
quand a JB il n'y a absolument rien de lui !!!!!
si une ligne de code y ressemble c'est une coïncidence ou tout simplement qu'il n'y a pas d'autre façon de l’écrire
pour les connecteurs je me suis aidé de l'aise MS et des tests a n'en plus finir car l'aide n'explique pas le phénomène post déplacement si incrementleft ou top

essayez donc de faire pareil avec pour seule méthode de construction et indexation celle de JB pour voir
c'est tout simplement impossible (si une seule ligne n'est pas dans le bon ordre ) ou alors usine a gaz
je le sais je me suis penché sur la question avec sa méthode (on peut rien en faire ) tout du moins dans le contexte d un visuel vertical indenté
d'ailleurs a voir le résultat de la méthode de JB elle a un bug tout du moins une coquille quelque part
car le visuel chez moi a des défauts de placement de shape qui ne sont pas cohérents avec le reste ( a moins que cela soit volontaire )

loin loin loin d’égaler la puissance de la mienne et tout les capacité qu'elle donne

donc rendre a césar ce qui est à césar c'est BIBI et pas JB ou p56

pour info le visuel de JB

 

[Staple1600]

Re

Bingo!
Ce qui confirme ce que Madame Irma disait plus haut
Tu poses des questions que tu résous tout seul
Et si on peut plus titiller le patrick , il y Ergo pour l'ego

Avec tout cela, t'as même pas cliqué sur mon petit lien ?

PS: J'ai jamais dit que ton code n'est pas du bel ouvrage.

Spoiler: Oncle Staple raconte

Mais sans la discussion de Cherrylee, donc du plagiaire de JB (identifié par Bubu (moi) car tu as déjà pris BIBI ), donc du zip de JB que j'ai posté dans sa question (zip qui t'a donné de fausses peurs), ta discussion auto-résolue ne serait point née.
(Ce n'est pas une critique. C'est purement factuel. Je le sais, j'étais là (Tu t'en souviens, Barbara )
Il n'y a donc rien d'inapproprié comme disait Bill, de dérouler la frise chronologique (et ses intervenants) qui t'a fait pondre des shapes dans cette période pré-Pascale, non, Patrick ?

Allez boujou et bonne nuit

 

[patricktoulon]

re
Bonjour Staple1600
a ben oui de toute façon une discussion en déclenche toujours une autre

ben oui je fini très souvent par trouver tout seul
c'est normal patience et moi ça fait 3
et je ne suis pas du genre a attendre la béquée
j'aurais appris a me servir des connecteurs
c'est dommage que quand on déplace le point de connexion a droite ou a gauche haut et bas sur le coté connecté il perd la connexion ça m'aurait économisé du code de repositionnement

avec le map xml on pourrait construire l' organigramme horizontal aussi comme l'exemple de JB et même le rendre interactif comme le mien on a tout en sortie du map