Excel - Extraire le texte d'un SmartArt avec VBA

Version imprimable

09/05/2017, 13h55
maximelocatelli

2 pièce(s) jointe(s)

Excel - Extraire le texte d'un SmartArt avec VBA

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 :

Pièce jointe 273299

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 :

Pièce jointe 273300

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

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

Code:

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

09/05/2017, 17h36
maximelocatelli

1 pièce(s) jointe(s)

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.

Pièce jointe 273411

Merci pour votre aide

Cordialement

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

Code:

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

11/05/2017, 08h38
maximelocatelli

Super travail mercatog !

Tu as résolu mon problème :D

Un grand merci à toi