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

patricktoulon

patricktoulon

XLDnaute Barbatruc
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

1647601646930.png


c'est après cette ligne que ca doit se placer
If parentshap.Name <> "" Then
le code en entier
VB: 
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
1647601966340.png
 

Pièces jointes

  • orgax.xlsm
    20.4 KB · Affichages: 9
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour le fil

patricktoulon
Je précise à ta place (par hommage) qu'il y a des petits bout de code de JB dans ton code ;)
Maintenant voyons ta refonte
¨Ma première question c'est pourquoi tu utilises
Set oXML = CreateObject("MSXML2.DOMDocument")
la méthode de JB avec des shapes basiques marchait bien, non ?

Donc il faut qu'on se complique ici la vie ?
(Va falloir que j'enfreigne mon fameux principe KISS) ;)[/SPOILER]
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
regarde de plus près tu verra que je me complique moins la vie pour remettre en ordre
les seuls code que JB que j'utilise sont ceux pour les connecteurs et lls ne fonctionnent pas chez moi
c'est juste pour tester
j'ai pour habitude et j'en suis meme fiers justement de faire différemment des autres
et entre parentheses quand je regarde les deux codes je suis pas sur que ca soit moi qui me soit compliqué la vie
c'est pas parce qu'un code fonctionne qu'il est optimal
moi j'ai besoin d'un organigramme style treeview (indenté)
quoi de mieux qu'un map xml dis moi (des boucles a gogo et des fonctions du style shapeexiste )😂😂
après je ne veux pas débattre de ma méthode (c'est la mienne ) c'est des connecteurs dont j'ai besoins que je n'arrive pas a transformer en équerre
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Je ne parle pas d'optimal ou pas optimal
Je demande juste pourquoi tu passes par MSXML2.DOMDocument pour manipuler des shapes.
Tu as répondu
moi j'ai besoin d'un organigramme style treeview
Cliquez pour agrandir...
Et je pense que comme d'habitude, tu vas trouver la réponse by yourself
(Si elle ne se trouve déjà pas dans tes archives DVP ;))

NB: Si j'ai cité JB, c'est pour être raccord avec le like que tu as mis sur mon message dans le fil de Cherrylee. Ni plus, ni moins
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
et oui si tu regarde bien dans le tableau il y a deux ligne qui ne sont pas dans l'ordre
1647644116032.png


avec la méthode de JB ça serait un vrai calvaire pour gérer ça pour une indentation TVW
après j'aurais pus utiliser une variable type aussi
créer tout les noms enfant et parent
et boucler sur la variable type mais c'est un peu plus compliqué
avec appendchild ca me remet tout en ordre en une ligne
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Je lis pas mal de tes discussions
Et il y en pas mal où tu trouves toi-même la solution ;)
(Peut pas te donner d'exemple puisque je peux pas cliquer sur ton pseudo ;))

En passant (c'est exprès qu'il manque un e ou c'est une coquille ?)
Set parnt
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

La syntaxe de l'aide en ligne peut-être t'inspirera-t-elle?
VB: 
Set myDocument = Worksheets(1) 
Set s = myDocument.Shapes 
Set firstRect = s.AddShape(msoShapeRectangle, 100, 50, 200, 100) 
Set secondRect = s.AddShape(msoShapeRectangle, 300, 300, 200, 100) 
Set c = s.AddConnector(msoConnectorCurve, 0, 0, 100, 100) 
with c.ConnectorFormat 
 .BeginConnect ConnectedShape:=firstRect, ConnectionSite:=1 
 .EndConnect ConnectedShape:=secondRect, ConnectionSite:=1 
 c.RerouteConnections 
End With
NB: Je viens de tester. Fonctionne sur mon Excel 2013
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour Staple1600
je n'avais pas vu ton dernier message
et finalement javais compris tout seul en faisant des tests dans une simple boucle
en fait les dimensions /positions se font avec une argumentation de type RECT
left top bottom right et non un left top width height
çà aurait du me mettre la puce a l'oreille les argument beginx beginy etc....
exemple
ceci fonctionne car on est dans une simple position c'est le bottom qui change
VB: 
Sub test1()
Dim i&, Connecteor As Shape, shap As Shape
For Each shap In Feuil1.Shapes
shap.Delete
Next
For i = 1 To 10
 Set Connector = Feuil1.Shapes.AddConnector(msoConnectorElbow, 15, 15, 50, i * 20)
                Connector.Name = "conn" & i
                Connector.Line.Visible = True
                Connector.Line.ForeColor.RGB = vbBlack
                Connector.Adjustments.Item(1) = 0
Next
End Sub

ceci ne fonctionnera pas
VB: 
Sub test2()
For Each shap In Feuil1.Shapes
shap.Delete
Next
Dim i&, Connecteor As Shape
For i = 1 To 10
 plusx = Round(15 * (Rnd * 15))
 Set Connector = Feuil1.Shapes.AddConnector(msoConnectorElbow, plusx, 15, 50, i * 20)
                Connector.Name = "conn" & i
                Connector.Line.Visible = True
                Connector.Line.ForeColor.RGB = vbBlack
                Connector.Adjustments.Item(1) = 0
Next

End Sub

par contre ceci oui il seront tous dans le même sens en angle droit
VB: 
Sub test3()
For Each shap In Feuil1.Shapes
shap.Delete
Next
Dim i&, Connecteor As Shape
For i = 1 To 10
 plusx = Round(15 * (Rnd * 15))
 Set Connector = Feuil1.Shapes.AddConnector(msoConnectorElbow, plusx, 15, 50 + plusx, i * 20)
                Connector.Name = "conn" & i
                Connector.Line.Visible = True
                Connector.Line.ForeColor.RGB = vbBlack
                Connector.Adjustments.Item(1) = 0
Next

End Sub

j'ai bien mes connecteurs en angle droit
c’était tout bête 😁
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
conclusion
VB: 
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 + (parentshap.Height / 2), shap.Left, shap.Top + (shap.Height / 2))
                connector.Name = shap.Name & "c"
                connector.Line.Visible = True
                connector.Line.ForeColor.RGB = vbBlack
                connector.Adjustments.Item(1) = 0
                Debug.Print shap.Name & " parent= " & parentshap.Name
            End If
        End If

    Next
End Sub

mon résultat est nikel
pas besoin de Beginconnect et EndConnect;)
demo3.gif
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
patricktoulon à dit:
conclusion
VB: 
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 + (parentshap.Height / 2), shap.Left, shap.Top + (shap.Height / 2))
                connector.Name = shap.Name & "c"
                connector.Line.Visible = True
                connector.Line.ForeColor.RGB = vbBlack
                connector.Adjustments.Item(1) = 0
                Debug.Print shap.Name & " parent= " & parentshap.Name
            End If
        End If

    Next
End Sub

mon résultat est nikel
pas besoin de Beginconnect et EndConnect;)
Regarde la pièce jointe 1134169
Cliquez pour agrandir...
Chalut Patrick : Bon alors ? tu le mets ton fichier :D:D:D:p
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

@patricktoulon
Tu confirmes donc ce je disais plus bas (lol)
Staple¸ médium à ses heures à dit:
Je lis pas mal de tes discussions
Et il y en pas mal où tu trouves toi-même la solution ;)
Cliquez pour agrandir...
Et une prédicition plus tard ;)
patrick à dit:
finalement javais compris tout seul en faisant des tests
Cliquez pour agrandir...

NB: Et dans celle-ci n'avait même pas vu mon dernier message ;)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
a ben moi y a rien qui m’arrête😂🤣
et j'aime bien découvrir tout seul
il me reste un seul truc a trouver
c'est de mettre le triangle de la flèche au shap et non au parent
peut être que la le Begin et End connect sera nécessaire car je suppose que ces deux fonctions gênèrent le sens de la connexion enfin je suppute

en l'etat voici mon fichier mis au propre
 

Pièces jointes

  • orgax.xlsm
    23.6 KB · Affichages: 14
Vote positif 0 Vote négatif

Membres actuellement en ligne

6 membres et 68 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 719
Messages
2 112 183
Membres
111 455
dernier inscrit
Jacandre