générer un organigramme schématisé avec les shapes depuis un fichier xls

zlacarter · 26 Octobre 2013

Bonjour à tous,
alors apres avoir écremer le net en long en large et travers sans trouver de réponse , voici mon pb :
je souhaiterai depuis un fichier xls ou csv contenant le code et libellé du niveau + d'autre sinformations) générer la schématisation d'un organigramme hierarchique .
mon organigramme comporte 5 niveaux maximum :

le niveau le plus haut est la direction générale codée sur 1 caractere (une lettre ex: A)
le 2eme niveau est la direction codée sur 2 caracteres (deux lettres, ex : AB)
le 3eme est le service codé sur 4 caracteres (deux lettres du dessus + 2 chiffres ex : AB01)
le 4 eme est le sous service sur 6 caracteres (2lettres + 4 chiffres ex : AB0101)
enfin le 5eme et dernier niveau est sur 8 caracteres (2lettres et 6 chiffres ex : AB010101)

j'aurai par exemple dans mon fichier un feuille de ce type :
A direction générale
AB direction xxx
AB01 service xxx
AB0101 sous service XXX
AC direction yyy
AC0101 sous service yyyyy
AC0102 sous service yyyyy
AC010201 bureau yyyy
B direction generale test
BA direction test
BA02 service test
....

Comment coder ca pour le représenter (via une macro ) graphiquement avec donc ces 5 niveaux maximum?

J'avais vu une source chez boisgontierjacques.free.fr/ mais son code ne marche pas des lors que ma codification contient de l'alphanumérique .et dans son exemple, la codification contient des points alors que moi c'est celle que je présente ci dessus.

Merci de votre aide car c'est tres important pour moi de pouvoir realiser cette schématisation pour pouvoir imprimer ces organigrammes.
Merci d'avance.

zlacarter

Staple1600 · 26 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Bonjour à tous

Juste pour infos
Pour ceux qui sont dans la situation de Dranreb
(Excel 2003)
Ajouter un organigramme hiérarchique - Excel - Office.com
(Excel 2010)
Où puis-je trouver l

Dranreb · 26 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Ah, oui. Ça j'ai. Jamais utilisé (il existe tellement de choses…). Il ne resterait plus qu'à trouver comment le piloter en VBA. Franchement je ne sais pas ce que ça apporterait par rapport à ce que j'ai commencé, notamment en matière de souplesse de finalisation.

BOISGONTIER · 26 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Orga Shapes

Cf PJ

Code:

Dim colonne, débutOrg, forga, inth, intv, Tbl(), n
Sub DessineOrga()
   Set forga = Sheets("orga")
   Set f = Sheets("bd")
   Tbl = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
   n = UBound(Tbl)
   For i = 2 To n
     If Len(Tbl(i, 1)) = 1 Then Tbl(i, 4) = "0" Else p = InStrRev(Tbl(i, 1), "."): Tbl(i, 4) = Left(Tbl(i, 1), p - 1)
   Next i
   For Each s In forga.Shapes
    If s.Type = 17 Or s.Type = 1 Then s.Delete
   Next
   inth = 50
   intv = 40
   colonne = 0
   Set débutOrg = forga.Range("a4")
   créeShape Tbl(1, 1), 1, Tbl(1, 2), Tbl(1, 3)
End Sub

Sub créeShape(parent, niv, Attribut, attribut2) ' procédure récursive
  hauteurshape = 30
  largeurshape = 90
  colonne = colonne + 1
  forga.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 22
  txt = Attribut & vbLf & attribut2
  With forga.Shapes(parent)
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
    .TextFrame.Characters(Start:=1, Length:=Len(Attribut)).Font.Bold = True
    .TextFrame.Characters(Start:=1, Length:=Len(Attribut)).Font.ColorIndex = 3
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
  End With
  forga.Shapes(parent).Left = débutOrg.Left + inth * colonne
  forga.Shapes(parent).Top = débutOrg.Top + intv * (niv - 1)
  For i = 1 To n
    If Tbl(i, 1) = parent And niv > 1 Then
      shapePère = Tbl(i, 4)
      forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
      forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
      forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(shapePère), 3
      forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 1
   End If
   If Tbl(i, 4) = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 2), Tbl(i, 3)
  Next i
End Sub

IL est possible d'ajouter du texte et des photos.

http://boisgontierjacques.free.fr/fichiers/Cellules/OrganigrammeHPhoto.xls

JB

chris · 26 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Bonjour à tous (que du beau monde sur ce fil

)

J'ai retrouvé un organigramme récupéré sur ce site https://www.excel-downloads.com/thr...amme-excel-avec-base-de-donnees-excel.198606/

Déjà fait par JB.

Dranreb · 26 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

J'ai un peu avancé dans la possibilité d'utiliser les macros avec d'autres classeurs. La feuille Données de celui ci est donc appelée à disparaitre.

mapomme · 26 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Bonsoir à tous

Pas facile d'être original avec les cadors présents sur le fil.
Voici donc un essai en mode "Texte" c'est à dire non graphique

.

Nota: un double-clique sur un service imprime (affiche l'aperçu) le service et les services rattachés.

Edit : pas la bonne version - j'ai sauvegardé la mauvaise et détruit la bonne - une partie à réécrire

BOISGONTIER · 27 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Bonsoir,

Version texte

Code:

Dim n, ligne, debOrg, Tbl()
Sub DessineOrgaTxt()
   Set f = Sheets("bd")
   Set forga = Sheets("orgaTexte")
   Set debOrg = forga.[A2]
   debOrg.Resize(20, 7).Clear
   Tbl = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
   n = UBound(Tbl)
   For i = 2 To n
     If Len(Tbl(i, 1)) = 1 Then
        Tbl(i, 4) = "0"
     Else
       If IsNumeric(Right(Tbl(i, 1), 2)) Then Tbl(i, 4) = Left(Tbl(i, 1), Len(Tbl(i, 1)) - 2) Else Tbl(i, 4) = Left(Tbl(i, 1), Len(Tbl(i, 1)) - 1)
     End If
   Next i
   ligne = 0: Ecrit Tbl(1, 1), 1, Tbl(1, 2)
   ligne = 0: Présentation Tbl(1, 1), 1
End Sub

Sub Ecrit(parent, niv, txt) ' procédure récursive
  ligne = ligne + 1
  debOrg.Offset(ligne, niv) = txt
  debOrg.Offset(ligne, niv).Borders(xlEdgeLeft).Weight = xlThin
  debOrg.Offset(ligne, niv).Borders(xlEdgeBottom).Weight = xlThin
  For i = 1 To n
    If Tbl(i, 4) = parent Then Ecrit Tbl(i, 1), niv + 1, Tbl(i, 2)
  Next i
End Sub

Sub Présentation(parent, niv) ' procédure récursive
  ligne = ligne + 1
  Fin = debOrg.Offset(ligne, niv).End(xlDown).Row
  If Fin < 100 Then
    For i = ligne To Fin - debOrg.Row
      debOrg.Offset(i, niv).Borders(xlEdgeLeft).Weight = xlThin
    Next i
  End If
  For i = 1 To n
     If Tbl(i, 4) = parent Then Présentation Tbl(i, 1), niv + 1
  Next i
End Sub

http://boisgontierjacques.free.fr/fichiers/Cellules/HierarchieShapes1.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/HierarchieShapes1Vertical.xls

JB

mapomme · 27 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

(re) Bonsoir à tous,

Bon, voici normalement la bonne version

Edit: j'ai fait "dans le compliqué et tordu", BOISGONTIER l'a fait "dans le simple et concis".

zlacarter · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

bonjour, merci mapomme je vais regarder ca de suite

et fais un retour

Dranreb · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Bonjour;
Ma dernière version avec les Shapes comme demandé initialement, avec la possibilité de seulement mettre à jour les textes des pavés existants.

zlacarter · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

mapomme à dit:
(re) Bonsoir à tous,

Bon, voici normalement la bonne version

Edit: j'ai fait "dans le compliqué et tordu", BOISGONTIER l'a fait "dans le simple et concis".

Alors deux observations :
les deux fichiers sont interessants , celui de jb permet une lecture d'organigramme verticale tel qu'il est utilisé dans les collectivités avec son connecteur et vraiment idéal a imprimer en revanche

Celui de pomme marche tres bien si ce n'est une présentation horyzontale qui complique la lecture (surtout si on a plusieurs services par exemples attachés).

Je vais regarder le tien danreb

BOISGONTIER · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Bonjour,

>Effectivement j'avais étudié la macro de JB qui est exellente et surtout donc automatisée comme demandé .(mais je n'arrive pas faire la meme chose en incluant des codes alpha numérique comme présenté dans mon fichier car lui utilise les codes avec des "." qui identifie les familles et sous familles alors que moi c'est plutot A puis AB puis AB01 ....)

Il me semble que le post #22 contient une version Shapes verticale et une version Texte qui utilisent la codification d'origine.

Code:

A       direction generale 1  Cmt1
AA     Direction 1               Cmt2
AA01 service                     Cmt3
B       direction generale 2  Cmt4
BA     direction2                 Cmt5
BA01 service 2                   Cmt6
BA02 service 2x                  Cmt7

Cf Organigramme hiérarchique avec shapes

http://boisgontierjacques.free.fr/fichiers/Cellules/HierarchieShapes1.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/HierarchieShapes1Vertical.xls
http://boisgontierjacques.free.fr/fichiers/jb-organigramme.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/GenealogieShapesBranche.xls

JB

zlacarter · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Dranreb à dit:
Bonjour;
Ma dernière version avec les Shapes comme demandé initialement, avec la possibilité de seulement mettre à jour les textes des pavés existants.

Excellent c'est exactement mes riteres recherchés . le dessin est top, tu as compris parfaitement ma demande.En revanche j'ai une question sur le fait de selectionner une celulle de départ pour le schéma, apparement on pourrait selectionner n'importe quel classeur ou plage mais qd j'en selctionne un nouveau, ca me génére une erreur (neanmoins ca dessine bien le schéma voulu).
vraiment c'est TOP

Dranreb · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Ah, je n'ai certes pas testé tous les cas de figure. Quelle erreur et sur quelle instruction ? Que je corrige ça sur la version en préparation, où on pourra choisir une disposition verticale ou horizontale…

zlacarter · 29 Octobre 2013

Re : générer un organigramme schématisé avec les shapes depuis un fichier xls

Qd tu cliques ca donnes erreur 424 "objet requis" mais ca te crées qd meme la forme . la ligne en erreur est la derniere ligne:
du module Sub PoserLesÉléments(Plages() As Range)

Feui.Names.Add "OrganiHautGauch", "=" & Plages(2).Address(External:=True)

générer un organigramme schématisé avec les shapes depuis un fichier xls

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Partager cette page

Statistiques des forums