Création SmartArt vba

[erics83]

Bonjour,

je cherche à créer un smartArt "processus" par vba, mais après plusieurs essais, notamment l'enregistreur de macro, cela ne fonctionne pas....mon essai :

En fait, il faudrait que je puisse "inscrire" via VBA "texte1", "texte2", etc.... et "Eric1", "Eric2", etc....dans le smartArt...

Merci pour votre aide,

 

[laurent950]

Bonjour,
Voici le code

Sub Macro1()
Dim oSALayout As SmartArtLayout
Set oSALayout = Application.SmartArtLayouts(44)
Dim oShp  As Shape
Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)

Dim QNodes As SmartArtNodes
Dim QNode As SmartArtNode
Set QNodes = oShp.SmartArt.AllNodes

For i = 1 To QNodes.Count  'supprime toutes les nodes de base
    oShp.SmartArt.AllNodes(1).Delete
Next

  ' Créer 5 Fléches comme dans l'exemple
    For i = 1 To 5
        Set QNode = oShp.SmartArt.AllNodes.Add 'ajoute une node
        Dim cpt As Integer
        cpt = cpt + 1
        QNode.TextFrame2.TextRange.Text = "Texte " & cpt 'ecris le texte
        Call Créer_Fils(QNode, cpt)
    Next i
End Sub

Sub Créer_Fils(Parent As SmartArtNode, cpt As Integer)
Dim FNode1 As SmartArtNode
Dim FNode2 As SmartArtNode
'va créer deux fils à mon parent
Set FNode1 = Parent.AddNode(msoSmartArtNodeBelow)
FNode1.TextFrame2.TextRange.Text = "Eric " & cpt
End Sub

Laurent

 

[erics83]

Bonjour Laurent950,

Super merci pour ce code, qui donne exactement le résultat recherché !!!

j'ai compris la logique du code, et vais pouvoir l'adapter...merci. j'étais vraiment très loin de trouver la solution .....merci !!!

Merci Laurent,

Eric,

 

[erics83]

Bonjour,

Juste dernière petite question, comment définir le positionnement du shape ?, par exemple, pour le mettre en A1 . et aussi comment définir la taille du

FNode1.TextFrame2.TextRange.Text = "Eric " & cpt

le mettre en auto-format par exemple...

edit : je viens de faire quelques essais, et lorsque je mets un nombre au delà de 5, le code bug (car d'après ce que je comprends, la forme ne peut accepter plus que 5 flèches....), y a -t -il une solution et/ou faut-il que je change le style de forme ?

Merci pour votre aide,
Eric

 

[laurent950]

Bonsoir :
Pour la position et réglage :
Pour plus d'info ce site est intéressant :
https://fring.developpez.com/vba/excel/zonetxt/

Sub Macro1()
Dim oSALayout As SmartArtLayout
Set oSALayout = Application.SmartArtLayouts(44)
Dim oShp  As Shape
'paramètres définissent les dimensions de la zone de texte et sa position sur la feuille :
'Hauteur = Height
H = 150
'Largeur = Width
W = 350
'Position horizontale = Left
L = Range("A1").Left '<-- position horizontale
'L = 0 ' egale A1
'Position verticale = Top
T = Range("A1").Top '<-- position verticale'Insertion de la zone de texte
'T = 0 ' egale A1
'''''Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)
Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout, L, T, W, H)

Dim QNodes As SmartArtNodes
Dim QNode As SmartArtNode
Set QNodes = oShp.SmartArt.AllNodes

For i = 1 To QNodes.Count  'supprime toutes les nodes de base
    oShp.SmartArt.AllNodes(1).Delete
Next

  ' Créer 5 Fléches comme dans l'exemple
    For i = 1 To 5
        Set QNode = oShp.SmartArt.AllNodes.Add 'ajoute une node
        Dim cpt As Integer
        cpt = cpt + 1
        QNode.TextFrame2.TextRange.Text = "Texte " & cpt 'ecris le texte
        Call Créer_Fils(QNode, cpt)
    Next i
End Sub

Sub Créer_Fils(Parent As SmartArtNode, cpt As Integer)
Dim FNode1 As SmartArtNode
Dim FNode2 As SmartArtNode
'va créer deux fils à mon parent
Set FNode1 = Parent.AddNode(msoSmartArtNodeBelow)
FNode1.TextFrame2.TextRange.Text = "Eric " & cpt
End Sub

Laurent

 

[erics83]

Super Merci Laurent,

Et merci pour les explications, super sympa !

Par contre, concernant le nombre de nodes, après plusieurs essais (infructueux) c'est vraiment limité à 5.....je vais devoir changer de SmartArt....

Merci pour votre aide,
Merci,

 

[laurent950]

Bonsoir,
C'est pré paramétré par l'application. je pense savoir comment faire pour ajouter d'autre dans
le SmartArt.
Ce soir je suis un peux fatigué mais je m'en occupe demain.

Ps : Une piste SmartArt C'est des objets graphiques placés d'une certaines façons est groupé. Donc peux
être dissocier le groupe et surement que l'ont peux ajouter d'autre objet et finir par regrouper le tout

Laurent

 

[erics83]

Merci Laurent,

Dissocier et ensuite regrouper, oui, la piste est intéressante....je vais essayer sans macro dans un premier temps, histoire de tester....

Merci pour ton aide,

 

[laurent950]

Bonsoir,
Ce week-end je vais jeter un coup d'oeil, je pense qu'il faut récupérer l'ensemble des noms des shapes
les stockés dans une variable tableau pour les dissocier. et regrouper.
Pas simple à expliquer comme cela.
si vous avez déjà fait des test je veux bien en prendre connaissance

Laurent

 

[erics83]

Bonjour Laurent,

Excusez moi pour ce retard de correspondance, mais j'ai voulu mettre à jour W10 et.....écran bleu, plantage, récupération données, remasterisation, bref, grosse galère et speed ces derniers jours....
J'ai essayé de dissocier/groupe, sans succès, j'ai juste réussi à "surperposer" les 2 shapes, et dû agrandir le format des flèches pour avoir l'alignement...:

c'est peut-être la solution (car j'ai vu que c'était beaucoup de répétition, donc, probablement possibilité de mettre sous forme macro), mais....j'ai besoin de votre aide....

Merci,