Discussion :

[zermatt]

Bonsoir,

Lorsque je fais une boucle avec le code For Each Shp In ActiveSheet.Shapes afin d'accéder à toutes les shapes présentes dans une feuille excel, celles qui ont été modifiées manuellement avec les points ne sont plus accessibles contrairement aux autres.

Mon objectif est d'enlever les couleurs de toutes les shapes pour pouvoir imprimer plus facilement.

Existe-t'il une solution ?, ou ces formes ne sont-elles plus accessibles une fois déformées.

Merci par avance.

[Invité]

Bonjour,

Sur Office 365, je n'ai pas ce problème, même avec des formes groupées.

[zermatt]

Merci, je suis sur Office 2016, je vais vérifier sur d'autres versions, le problème vient peut-être de là.

[Invité]

Mettez un fichier en ligne avec plusieurs de vos formes avec et sans modif pour voir.

[zermatt]

Merci, pourriez-vous tester la macro dans le fichier ci-joint permettant d'afficher le nom et le contenu des formes (ici 3 incluant le bouton de la macro) dans un premier temps,
puis de modifier un rectangle avec "clic droit - modifier les points" et de tester à nouveau la macro.

Dans le deuxième cas la macro plante au moment de lire le contenu du rectangle déformé.

Merci par avance pour votre aide. Le problème vient peut-être de mes connaissances rudimentaires sur le sujet ou de ma version d'office pro 2016 (windows), mais je n'en ai pas d'autres sous la main.

edit : le fait d'ajouter un simple connecteur (ligne droite) par exemple, provoque le même arrêt de la macro.
j'ai aussi testé sur un Macbook, même problème.

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
 
Sub test_shape()
 
Dim Shp As Shape
Dim nomRectangle As String
Dim contenu As String
 
For Each Shp In ActiveSheet.Shapes
 
            nomRectangle = Shp.Name
            MsgBox nomRectangle
 
            contenu = Shp.TextFrame.Characters.Text
            MsgBox contenu
 
Next Shp
 
End Sub

[Invité]

M

C'est lié au type de la forme. Testez cette procédure :

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
21
22
23
24
25
 
Sub test_shape()
 
Dim Shp As Shape
Dim NomRectangle As String
Dim Contenu As String
 
 
    For Each Shp In ActiveSheet.Shapes
 
        With Shp
             NomRectangle = .Name
             Contenu = ""
             Select Case .Type
                    Case 1, 8
                         Contenu = .TextFrame.Characters.Text
                    Case 5
                         If .TextFrame2.HasText Then Contenu = .TextFrame2.TextRange
             End Select
             MsgBox "Nom : " & NomRectangle & Chr(10) & "Type : " & Shp.Type & Chr(10) & "Contenu : " & Contenu
        End With
 
    Next Shp
 
End Sub

[zermatt]

Merci infiniment pour la rapidité et la solution qui fait sens.
Faire un test sur la forme est très judicieux. Bravo !