Discussion :

[maximelocatelli]

Bonjour,

Je souhaiterais réaliser une petite macro me permettant d'extraire le texte contenu dans un SmartArt afin de le coller dans des cellules.

Explication :

Travaillant dans un service qualité, nous réalisons les analyses des causes des non-conformités en réalisant un SmartArt de type hiérarchique pour réaliser un arbre des causes.

Voici le type de SmartArt obtenus :



Je souhaiterais avoir une macro pour incrémenter mon tableau "plan d'actions" et avoir la cause dite "racine" (celle en rouge) qui s'ajoute automatiquement à mon tableau en fonction du SmartArt.

Pour illustrer mes propos voici un schéma de ce que je souhaiterais réaliser :



Les flèches rouge correspondent au données texte que je souhaiterais voir apparaître dans mon tableau grâce à la macro.

Le problème est que je ne sais pas du tout comment procéder pour lire le contenu d'un SmartArt via VBA.

J'attends vos pistes et idées

Merci d'avance

[mercatog]

Commence par ce code et regarde ta fenêtre d'exécution vba

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Test()
Dim SA As SmartArt
Dim i As Integer
 
Set SA = Feuil1.Shapes(1).SmartArt  'remplace le 1 par l'index de ton smartart
With SA
    For i = 1 To .AllNodes.Count
        Debug.Print i & "  -  " & .AllNodes(i).Level & "  -  " & .AllNodes(i).TextFrame2.TextRange.Text
    Next i
End With
Set SA = Nothing
End Sub

[maximelocatelli]

Merci mercatog pour cette réponse rapide.

Votre code semble bien fonctionner puisqu'il balaye l'ensemble des formes de mon SmartArt.

Savez-vous s'il est possible que le code ne sélectionne que le texte en rouge (ou a défaut non noir) pour le coller dans mon tableau en dessous en actions correctives ?

Si cela peut permettre de mieux appréhender la problématique voici le fichier sur lequel je travail.

Recherche des causes.xlsx

Merci pour votre aide

Cordialement

[mercatog]

Bah je t'avais donné la piste. Il suffit de voir les propriétés de la variable SA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Test()
Dim SA As SmartArt
Dim i As Integer
Dim j As Long
 
Set SA = Feuil1.Shapes(1).SmartArt
j = 26
With SA
    For i = 1 To .AllNodes.Count
        With .AllNodes(i).TextFrame2.TextRange
            'If .Font.Fill.ForeColor = 255 Then '255 correspond au rouge ou RGB(255,0,0)
            If .Font.Fill.ForeColor <>0 Then '0 correspond au noir ou RGB(0,0,0)
                Feuil1.Cells(j, 2) = .Text
                j = j + 1
            End If
        End With
    Next i
End With
Set SA = Nothing
End Sub

[maximelocatelli]

Super travail mercatog !

Tu as résolu mon problème

Un grand merci à toi