Excel - Organigramme avec photos (SmartArt créé automatiquement)

[@monsieurexcel7721]

Dim ogSALayout As SmartArtLayout Dim QNode As SmartArtNode Dim oShp As Shape Dim QNodes As SmartArtNodes Dim t As Integer On Error GoTo Erreur Set ogSALayout = Application.SmartArtLayouts(91) Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout) Set QNodes = oShp.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 With QNodes(Range("B" & i)).Shapes.Item(2).Fill .Visible = msoTrue .UserPicture "C:\Users\LucanoM\Downloads\Organigramme avec images\Images" & "\" & Range("E" & i) .TextureTile = msoFalse End With 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"

[@abidoulkadi1314]

Je vous remercie infiniment. A+

[@glacefrozen6512]

Sub AbreGénéalogique() Dim ogSALayout As SmartArtLayout Dim QNode As SmartArtNode Dim oShp As Shape Dim QNodes As SmartArtNodes Dim t As Integer Set ogSALayout = Application.SmartArtLayouts(91) Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout) Set QNodes = oShp.SmartArt.AllNodes Set QNode = oShp.SmartArt.AllNodes.Add 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 With QNodes(Range("B" & i)).Shapes.Item(2).Fill .Visible = msoTrue .UserPicture "C:\Users\Médrich\Documents\Administration" & "\" & Range("E" & i) .TextureTile = msoFalse End With 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 End Sub

[@enricoronconi6960]

Très bien , j’ai testé la macro et elle fonctionne . Beaucoup de temps de gagner . Merci à vous cordialement

[@monsieurexcel7721]

Super, merci pour votre message. Passez un bon dimanche, Maxime

[@mohamedrachad7606]

Merci beaucoup pour ce tuto

[@jeannoelrakotoarisoa2847]

Merci!

[@kamelderbali6398]

merci pour le code

[@elody1271]

Trop bien!!!! Merci milles fois !!!

[@monsieurexcel7721]

Merci à vous pour votre commentaire ! Bonne journée

[@jpeboscq]

Fonctionne parfaitement, merci ! Pensez-vous qu'il est facile de transformer cet organigramme en mode horizontal ? Excel ne le propose pas, j'imagine qu'il faut faire une autre macro... mais aucune idée de la faisabilité ?!

[@DelphineMOUILLIÉ]

Bonjour. Quand je veux générer l'organigramme, j'ai une erreur compilation qui s'affiche, pouvez vous m'aider

[@elhadjigano9076]

Hello Monsieur, Quand the copy le programme ci-dessous, j'ai un bug et la ligne ci-dessous est surlignée en jaune : With QNodes(Range("B" & i)).Shapes.Item(2).Fill une idée de comment débugger ca?

[@monsieurexcel7721]

Bonjour, est-ce que vous avez bien enregistré les photos dans un dossier sur votre ordinateur et personnalisé le chemin d'accès comme dans la vidéo ?

[@AlainMayaud]

Bonjour, Merci beaucoup pour vos vidéos. Elles sont très utiles. Je dois réaliser un organigramme pour une équipe de 35-40 personnes. J'ai suivi toute la procédure, mais le débogueur indique une erreur sur la ligne du fichier photos. Est-ce parce que les photos sont sont un OneDrive?

[@louisebrais]

Bonjour, j'ai suivi toutes les instructions mais j'ai toujours un message d'erreur concernant le chemin du fichier des photos. Le bouton fonctionne pas tout le temps. En plus, je n'ai pas les niveaux hiérarchiques, ils sont au même niveau. Pouvez-vous m'aider?

[@hubaero9468]

Bonjour, Pourrais-je avoir la macro, comment fait on pour changer de modèle d’organigramme. Merci

[@monsieurexcel7721]

Bonjour, vous trouverez ci-dessous la macro : Dim ogSALayout As SmartArtLayout Dim QNode As SmartArtNode Dim oShp As Shape Dim QNodes As SmartArtNodes Dim t As Integer On Error GoTo Erreur Set ogSALayout = Application.SmartArtLayouts(91) Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout) Set QNodes = oShp.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 With QNodes(Range("B" & i)).Shapes.Item(2).Fill .Visible = msoTrue .UserPicture "C:\Users\LucanoM\Downloads\Organigramme avec images\Images" & "\" & Range("E" & i) .TextureTile = msoFalse End With 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"

[@aureliemarcault]

bonjour j ai un message d erreur lorsque j appuie sur le bouton créé que dois je faire?

[@aureliemarcault]

ou est il possible de m envoyer votre fichier deja parametrer?

[@monsieurexcel7721]

@@aureliemarcault Bonsoir, oui, envoyez moi un mail : [e-mail]

[@jean-mariebaras9364]

Bonjour lors de l'exécution de la macro, il ya a un message d'erreur "étiquette non définie" sur la ligne : On Error GoTo Erreur. Cordialement

[@monsieurexcel7721]

Bonsoir, je pense qu'il vous manque 2 lignes de codes à la fin de la macro (entre Sub et End Sub) Exit Sub Erreur: MsgBox "Une erreur est survenue"

[@loicsalaun9328]

Bonjour, tout d'abord merci pour votre tuto! Petit souci pour moi sur créer un lien physique par un tiret entre deux personnes du rang 1. Merci pour la solution...

[@monsieurexcel7721]

Bonjour, merci à vous pour votre message. Malheureusement je n'ai aucune solution qui permette d'ajouter une connexion entre deux personnes du même rang. Désolé ... la seule solution serait d'ajouter "manuellement" une ligne.

[@gillessie4807]

Bonjour Mr Excel j'aimerais recevoir le fichier concernant l'organigramme si possible merci de me repondre .Mr sie

[@monsieurexcel7721]

Bonsoir, oui aucun souci. Pourriez-vous m'envoyer un mail svp ? [e-mail]

[@annabellemettaz5049]

Je copie et colle le code mais je n’ai pas de ligne userpicture qui s’affiche. Une idée d’où vient mon problème ?

[@annabellemettaz5049]

Je transmets volontiers une photo de la situation. Merci pour votre aide

[@monsieurexcel7721]

@@annabellemettaz5049 Bonjour, Lorsque vous copiez le code VBA, la ligne "UserPicture" disparaît ? Oui je veux bien, pourriez-vous m'envoyer la photo sur mon e-mail ci-dessous svp ? [e-mail]

[@cecilias2039]

Bonjour, J'ai suivie tous les étapes pour faire un organigramme. Le bouton ne marche pas or j'ai copié le programme que vous avez communiquer. J'ai modifier le "User....". Quelle est mon erreur?

[@monsieurexcel7721]

Bonjour, Pourriez-vous m'envoyer une capture d'écran de votre fenêtre Visual Basic contenant le code VBA svp ? Est-ce que vous avez un message d'erreur ? [e-mail] Avez-vous bien lié la macro au bouton ? Si besoin je peux aussi vous envoyer le fichier Excel utilisé dans la vidéo par e-mail. Bonne journée Maxime

[@lucasalric628]

Bonjour, j' aimerais faire la même chose mais sans connaître le niveau. Remplacer les niveaux par les antécédents indirect qui faudrait transformer en direct pour pouvoir continuer

[@monsieurexcel7721]

Bonjour, qu'entendez-vous par antécédent ? Est-ce que vous souhaitez utiliser les nom/prénoms des employés à la place des niveaux ?

[@geraldineparis868]

Bonjour, Super tuto. Par contre, je n'arrive pas à le faire fonctionner sur Windows 10 / Excel 365, j'ai "Une erreur est survenue". Pouvez vous m'aider? Merci

[@monsieurexcel7721]

Bonjour, merci. Il se peut que l'erreur provienne des données du tableau, est-ce que vous pourriez m'envoyer une capture écran de votre tableau svp ? Merci

[@persovo8245]

Bonsoir les étiquettes viennent se superposer sur les images. Je vous ai envoyé le fichier par mail. C'est super mais ça bug pour mon exemple. Merci à vous et bravo pour tout vos exemples

[@SamSung-et3dp]

Comment peut on avoir le bouton ( generer un diagramme )?

[@monsieurexcel7721]

Les étapes sont expliquées dans la vidéo, il faut ajouter un bouton en ajoutant l'onglet "développeur"

[@yousseflahbiel4033]

Pourrez vous partager le lien de ce modèle "Template" si c'est possible, parce que j'ai trouvé plusieurs problèmes .

[@monsieurexcel7721]

Bonjour, Oui pas de problème, envoyez moi un mail comme ça je vous partagerai le fichier Excel. [e-mail] Merci

[@lezinmalekou8835]

​@@monsieurexcel7721Merci pour ce tuto, mais j'ai un problème, le déboguer indique une erreure

[@francoislagace3465]

Bonjour tout va bien et c’est superbe. Le seul problème est qu’il y a un ajout d’une 7e boîte alors que je n’ai que 6 entrer dans mon tableau ?? Une idée du pourquoi ?

[@monsieurexcel7721]

Bonjour, non désolé. Vous pouvez néanmoins la supprimer en la sélectionnant. Merci

[@monsieurexcel7721]

Bonjour, non désolé. Vous pouvez néanmoins la supprimer en la sélectionnant. Merci

[@jordanndongolepoukou2309]

Bonjour,Merci pour cette vidéo. je viens de faire plusieurs fois j'ai créer le tableau à partir de la cellule b3,j'ai remis le chemin pour recuperer les photos qui sont bien de type jpg dans le code mis en commentaire ,j'ai creé le bouton lié à la macro.Quand je clique sur le bouton,j'ai " une erreur est survenue et quand je clique sur ok j'ai un organigramme qui s'affiche sans mes donnés du tableau

[@monsieurexcel7721]

Bonjour, merci pour votre message. Pourriez-vous svp m'envoyer une capture d'écran de votre tableau ainsi que de l'organigramme qui a été généré ? [e-mail] Merci d'avance, Maxime

[@davidbadot4332]

Bonjour, la macro est-elle correcte (à ce jour) ou devons-nous vous envoyer un mail pour la recevoir ?

[@monsieurexcel7721]

Bonjour, le code VBA utilisé dans la vidéo fonctionne parfaitement. Il y a quelques fois des erreurs, mais celles-ci proviennent principalement des données du tableau. Si besoin, je peux tout de même vous envoyer le fichier Excel par mail. N'hésitez pas si besoin, bonne journée

[@melissaporet]

Bonjour j’ai essayé mais à la fin une boîte de dialogue s’ouvre me disant une erreur est survenue . J’ai du faire une erreur quelque part , serait il possible d’avoir le fichier par mail ?

[@aurelieRoumagnac]

Bonjour Merci pour cette vidéo , Mais cela ne fonctionne pas pour moi voici le message d'erreur : erreur de compilation : Etiquette non définie Pouvez vous m'aider à corriger?

[@monsieurexcel7721]

Bonsoir, merci pour votre commentaire. Je pense qu'il vous manque une partie du code VBA. Tout en bas de la macro, juste avant "End Sub", est-ce que vous avez bien les 2 lignes ci-dessous ? Exit Sub Erreur: MsgBox "Une erreur est survenue" Je reste à disposition si besoin Bonne soirée

[@aurelieRoumagnac]

@@monsieurexcel7721 merci pour votre réponse. Oui les 2 lignes sont bien là

[@aurelieRoumagnac]

cela indique : Erreur d'exécution '-2147024894 (80070002)': La méthode 'UserPicture' de l'objet 'FillFormat' a échoué

[@AureliieB]

Bonjour, je me suis permise de vous envoyer un mail au nom de Aurélie Salles la semaine dernière pour avoir précision concernant les organigramme, Pouvez-vous me dire si vous l'avez bien eu ? Bonne journée

[@jeanchristophecaillou3072]

Bonjour, TOP ta macro !! Est-ce que tu aurais la possibilité de proposer une macro générant un organigramme dans lequel on peut aussi afficher des "assistants" (présentation isolée entre 2 niveaux). Merci d'avance !!

[@monsieurexcel7721]

Bonjour, merci beaucoup ! Oui j'ai prévu de faire un nouveau tutoriel sur le sujet (par contre cela est restreint à certains types d'organigramme, celui avec photos ne pourra pas être utilisé). Bonne journée 🙂

[@daniellancelin1187]

Bonjour et merci pour cet excellent tuto. J'apprécie beaucoup le fait de travailler avec les données qui sont dans une table. Dans la table, j'ai ajouté une colonne contenant un nom de fichier à appeler. Cependant, je n'ai pas encore réussi à trouver la syntaxe adéquate pour écrire le code permettant d'appeler le fichier. (Je précise que l'ajout manuel, une fois l'organigramme créé, fonctionne bien. L'enregistrement Macro ne donne rien) Votre aide me serait bien précieuse. Merci Et bonne année 2022 à tous.

[@monsieurexcel7721]

Bonsoir, Merci pour votre message et bonne année 2022 à vous aussi. Quel est le format du fichier que vous souhaitez appeler ? Est-ce que vous avez un fichier par employé ? Merci, bonne soirée

[@daniellancelin1187]

@@monsieurexcel7721 Bonjour, et merci pour votre réponse. Je voudrais, en cliquant sur la photo, appeler le fichier unique spécifique associé à chaque photo et défini dans la table. Dans l'idéal ce pourrait être tout type de fichier, et même une URL. Mais ce sera principalement des fichiers Excel et des fichiers PDF. Merci à vous et bonne journée.

[@monsieurexcel7721]

@@daniellancelin1187 Bonjour, j'ai fait quelques essais malheureusement je n'arrive pas à trouver une solution utilisable sur l'organigramme. Désolé, passez un bon après-midi

[@daniellancelin1187]

@@monsieurexcel7721 Merci, bonne soirée à vous.

[@mohamedazizmehri9609]

What is wrong with.UserPicture?? .UserPicture "C:\Utilisateurs\oumay\Images" & "\" & Range("E" & i)

[@monsieurexcel7721]

Hi, Did you use your own folder path?

[@mohamedazizmehri9609]

@@monsieurexcel7721 nah it's ok i fixed it

[@mignonrodmankoumou-bongo669]

Apparement ça ne marche pas avec windows 7. Les deux vidéos

[@monsieurexcel7721]

Bonjour, en effet Windows 7 génère des erreurs. Est-ce que vous voulez que je vous envoie le fichier par mail pour essayer ?

[@daoudalofo3255]

BONJOUR MERCI POUR CE TUTO FORMIDABLE MAIS LE PROBLEME EST QUE JE NE VOISPASLE CODE DONT VOUS PARLEZ MERCI

[@monsieurexcel7721]

Bonjour, merci pour votre message. Le code se trouve sur le commentaire ayant été épinglé. Bonne journée, Maxime

[@sophieauffret8282]

Bonjour, Comment dois-je fais si je veux ajouter la fonction générer un organigramme et intégrer les photos dans la même macro? Je colle le code à suivre dans le visual basic mais sur le même module?

[@monsieurexcel7721]

Bonjour, Le code VBA de cette vidéo permet de faire les deux (création de l'organigramme et ajout des photos). Oui, vous pouvez le coller sur le même module, en ajoutant un bouton qu'il faudra lier à cette macro. Si besoin vous pouvez me contacter par mail. Cordialement,

[@sophieauffret8282]

@@monsieurexcel7721 Bonjour, je vous ai envoyé un mail vendredi. J'espère que vous pourrez m'aider. Un grand merci! Sophie

[@abdelazizblilid6062]

Erreur de compilation: Type défini par l'utilisateur non défini.

[@ClaudieGervais]

j'ai fait toutes les étapes du vidéo est ca me sort un message d'erreur .... HELP Dim ogSALayout As SmartArtLayout Dim QNode As SmartArtNode Dim oShp As Shape Dim QNodes As SmartArtNodes Dim t As Integer On Error GoTo Erreur Set ogSALayout = Application.SmartArtLayouts(91) Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(ogSALayout) Set QNodes = oShp.SmartArt.AllNodes t = QNodes.Count

[@monsieurexcel7721]

Bonjour, quel message d'erreur obtenez-vous svp ?

[@fredericschwartz3771]

Bonjour, super Tuto. Est ce que le code fonctionne aussi avec un mac ? Est il possible d'avoir le fichier ? [e-mail] Merci par avance bonne fin de journée

[@monsieurexcel7721]

Bonsoir, merci pour votre message. Je n'ai pas eu l'occasion d'essayer sur Mac, je pense que oui. Pas de problème, je vous l'ai envoyé à l'instant par mail. Bonne soirée

[@beloute31]

@@monsieurexcel7721 pouvez-vous le partager à tout le monde, sur Mac ? Merci bcp