[VBA-E]Effacer les shapes

**tinmarbusir** · 09/06/2006, 14h18

Un bug d'Excel m'ennuie un peu!(j'espère que c'est plutôt une erreur de ma part!

Un programme me crée des shapes,jusque là tout va bien
à chaque fois que je le relance j'efface les shapes de la feuille histoire que ce soi t un peu plus clair...

Code :

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

1
2
3
4
5
Dim forme As Shape
 
For Each forme In Worksheets("feuil4").Shapes
   forme.Delete
Next forme

Quand je le lance j'obtiens l'erreur
La méthode 'Delete' de l'objet 'Shape' a échoué
suivi du

Microsoft Excel a rencontré un problème et doit fermer. Nous vous prions de nous excuser pour le désagrément encouru.
les infomations sur lesquelles vous travailliez peuvent avoir été perdues.
Microsoft Excel peut tenter de les récupérer
...........

Ah j'oubliai un détail intéressant.Quand j'utilise le débogueur(Pas à pas détaillé), il n'y a pas de problème...

Quelqu'un aurait il une explication si vou plééé???

**Catbull** · 09/06/2006, 16h07

Ca m'a l'air en effet d'être un bug. Chez moi ce code fonctionne très bien (Excel 2000 SP3).

Peut-être que le classeur n'est plus intégre. Essaie de copier les feuilles de ton classeur dans un autre classeur ainsi que les macros pour voir si le problème persiste.

**zazaraignée** · 09/06/2006, 18h12

Salut

T'as essayé dans un compte à rebours?

Code :

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

1
2
3
4
Dim i As Integer
For i = Feuil14.Shapes.Count to 1 Step -1
    Shapes(i).Delete
Next

[Edit] Apparemment, les indices des Shapes commencent à 1...

**SfJ5Rpw8** · 09/06/2006, 18h39

essai de voir quel "shape" provoque ton plantage ..:

Code :

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

1
2
3
4
5
6
7
8
 
Dim forme As Shape
For Each forme In Worksheets("feuil4").Shapes
   Debug.Print forme.Name
   Debug.Print forme.Type
   Stop
   forme.Delete
Next forme

le code s'arrête sur l'instruction Stop ... , observe le résultat dans fenêtre exécution, puis actionne F5 pour détruire le shape en cours.. ..

**tinmarbusir** · 12/06/2006, 09h44

Salut
Après un bon week-end à la campagne, je suis retourné à ce

problème de "shapes". Je vous remercie tout d'abord pour vos réponses...

Code :

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

1
2
3
4
5
6
7
Dim Ftriangle As Shape
 
For Each Ftriangle In Worksheets("feuil4").Shapes
   Debug.Print "nom :" & Ftriangle.Name; " - Type : " & Ftriangle.Type
   Stop
   Ftriangle.Delete
Next Ftriangle

Avec ce code, il n'y a bizzarement pas d'erreur.(Comme avec le pas à pas)
En enlevant le Stop aussi...
Mais en enlevant la ligne debug.print, et bin çà marche encore
Ah bah non çà marche plus...

(en clair çà marche nickel en pas à pas ou avec le stop sinon çà plante)

Je viens de remarquer autre chose. Quand je lance la macro depuis la feuille ou se trouve les données, l'éxécution trouve la même erreur mais ne plante pas...Elle plante quand je resélectionne la feuille des formes (la "feuil4")...
En revanche, quand la feuille ou sont dessinées mes formes est sélectionnée(des triangles en l'occurence), je me retrouve avec l'erreur...

pourquoi VBA il est pas gentil avec moiiii?

**Ania** · 12/06/2006, 13h24

Juste comme ca parce que j'ai eu le cas une fois

est-ce la feuille ou tu supprime les shape est active ou du moins visible quand tu lance ta fonction?

**tinmarbusir** · 12/06/2006, 15h15

bah çà dépend..
Quand elle est visible et là çà plante tout le temps
Quand elle n'est pas visible des fois çà ce passe bien des fois j'ai le message d'erreur. Et Excel plante ensuite quand je rend la feuille des triangles actives...

**zazaraignée** · 12/06/2006, 15h24

Envoyé par Ania

Juste comme ca parce que j'ai eu le cas une fois

est-ce la feuille ou tu supprime les shape est active ou du moins visible quand tu lance ta fonction?

+1

Essaie d'appeler ta shape d'abord par la feuille où elle est

Code :

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

Feuil14.Shapes("Ftriangle").Delete

**tinmarbusir** · 12/06/2006, 15h58

Code :

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

1
2
3
4
5
6
For Each Ftriangle In Worksheets("feuil4").Shapes
   ville = ville + 1
   Debug.Print "nom :" & Ftriangle.Name; " - Type : " & Ftriangle.Type
'   Stop
   Ftriangle.Delete
Next Ftriangle

Yo c'est bien chaque triangle de la feuille "feuil4" qui est concernée non?

**zazaraignée** · 12/06/2006, 16h09

Bon, mouais! en effet!

Alors, je re-pose ma question:
T'as essayé dans un compte à rebours?

Code :

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

1
2
3
4
Dim i As Integer
For i = Feuil14.Shapes.Count to 1 Step -1
    Shapes(i).Delete
Next

**tinmarbusir** · 12/06/2006, 16h27

Je suppose que tu voulais dire

Code :

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

1
2
3
4
Dim i As Integer
For i = Worksheets("Feuil4").Shapes.Count To 1 Step -1
    Worksheets("Feuil4").Shapes(i).Delete
Next

Le code fonctionne avec le débogueur
mais en éxécution çà plante aussi. La seule différence est que l'erreur

La méthode 'Delete' de l'objet 'Shape' a échoué

n'apparait plus (bah ouai y'a plus d'objet shape!)

Merci quand même!
zarma je désespère j'en ai marre de devoir effacer 40 formes une par une avant d'éxécuter!!!On s'habitue tellement vite aux macros...

**Ania** · 13/06/2006, 08h33

J'ai un p'tit bout de code que j'ai utilisé pour supprimer des images.
peut etre que ca pourra vous aider.

Code :

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

1
2
3
4
5
6
7
8
9
Sub EffaceImage()
  Sheets("Devis").Select
  On Error Resume Next
  For i = 400 To 460
    ActiveSheet.Shapes("Image " & i).Delete
    ActiveSheet.Shapes("Groupe " & i).Delete
  Next i
  On Error GoTo 0
End Sub

bonne continuation

**tinmarbusir** · 13/06/2006, 09h25

C'est gentil mais à chaque fois mes formes prennent un nom différent... En fait je crèe plusieurs formes que je fusionne progressivement. Pour arriver à 20-25 formes à la fin.
Par contre je n'avais pas pensé àutiliser la gestion d'erreur. Est ce qu'elle pourrait mêtre utile pour éviter le plantage d'Excel? Je ne me souviens plus e la syntaxe de la gestion d'erreur...

**Ania** · 13/06/2006, 10h13

ok

dans ce cas peux tu nommer tes shapes ou du moins les renommer c'est ce que j'avais fait.
Car je souhaitais conserver certaines images et pas d'autres, toutes mes images ayant un n° supérieur à 400 étaient supprimer, mais moi je faisais une copie d'image et non une création

bon courage ++

**tinmarbusir** · 13/06/2006, 10h19

En fait j'ai déjà essayé de les renommer mais un nouveau nom est attribué automatiquement à chaque "groupement" de deux formes...
et étant donné qu'il y a une 20 de formes groupées ensemble à chaque fois et que je les rajoute une par une.Il faut renommer à chaque fois

**Ania** · 13/06/2006, 14h07

dans ce cas ne peux tu pas renommer seulement le dernier groupe créer si tu connais le nombre de shapes que tu dois créer

**zazaraignée** · 13/06/2006, 14h56

Envoyé par tinmarbusir

C'est gentil mais à chaque fois mes formes prennent un nom différent... En fait je crèe plusieurs formes que je fusionne progressivement. Pour arriver à 20-25 formes à la fin.
Par contre je n'avais pas pensé àutiliser la gestion d'erreur. Est ce qu'elle pourrait mêtre utile pour éviter le plantage d'Excel? Je ne me souviens plus e la syntaxe de la gestion d'erreur...

Et c'est maintenant que tu songes à nous dire qu'il y avait des regroupements

Avant de me taper sur le crane à coup de marteau, l'ami, songe à nous dire la totale de tes manip sur les shapes.

Et les dégrouper avant de les effacer... t'as songé?

[Edit] avec excuses... le dégroupement est à oublier...
Ceci dit, J'ai testé chez mois différentes formes, groupées et pas groupées, j'ai effacé avec une petite macro nommée toto:

Code :

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

1
2
3
4
5
6
Sub toto()
    Dim forme As Shape
    For Each forme In Feuil1.Shapes
        forme.Delete
    Next
End Sub

et toto marche à tous les coups. Alors questions:

Combien de niveaux de groupements as-tu?
Renommes-tu tes shapes et tes groupes à la main (ou par code)? Si oui, comment? (propriété Name...?)
Y a-t-il un autre truc que tu as omis dans tes explications?

**tinmarbusir** · 14/06/2006, 13h30

J'aurai peut-être du commencer par vous monter mon code...
les procédures Sub triangle_diachronique() et Sub triangle_synchronique() appelent les procédures Triangle et ajouter_point...

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit
Const Ltxt = 35
Const Htxt = 26.5
Const ColPct1 = 15 'Colonne Proportion de Hapax
Const ColPct2 = 19 'Poids des trois principaux patronymes
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub triangle_diachronique()
'1 triangle par ville, 1 point par periode
Dim pct(1 To 3) As Double
Dim ligne As Integer, ville As Integer, periode As Integer
Dim Ftriangle As Shape, Forme1 As Shape
Dim text As String
 
'ville = 0
'For Each Ftriangle In Worksheets("feuil4").Shapes
'   ville = ville + 1
'   Debug.Print "nom :" & Ftriangle.Name; " - Type : " & Ftriangle.Type; " -Numero : " & ville
'   Stop
'   Ftriangle.Delete
'Next Ftriangle
Dim i As Integer
For i = Worksheets("Feuil4").Shapes.Count To 1 Step -1
    Worksheets("Feuil4").Shapes(i).Delete
Next
 
ville = 0
For ligne = 2 To 101
   pct(1) = Sheets("feuil1").Cells(ligne, 15).Value
   pct(2) = Sheets("feuil1").Cells(ligne, 19)
   pct(3) = 1 - (pct(1) + pct(2))
   If ligne Mod 4 = 2 Then
      ville = ville + 1
      text = "Ville :" & Application.WorksheetFunction.VLookup(ville, Worksheets("Feuil1").Range("A105:D129"), 2)
      Call Triangle(Ftriangle, pct, ville, "Feuil4", text)
      periode = 0
   End If
   periode = periode + 1
   Call ajouter_point(Ftriangle, pct, periode)
Next ligne
End Sub
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub triangle_synchronique()
'1 triangle par periode, 1 point par région
Dim pct(1 To 3) As Double
Dim ligne As Integer, periode As Integer, region As Integer
Dim Ftriangle As Shape
Dim text As String
 
'on efface tout
For Each Ftriangle In Worksheets("Feuil triangle2").Shapes
   Debug.Print "nom :" & Ftriangle.Name; " - Type : " & Ftriangle.Type
   'Stop
   Ftriangle.Delete
Next Ftriangle
 
 
periode = 0
For ligne = 2 To 21
   pct(1) = Sheets("Feuil Microregion").Cells(ligne, 3).Value 'les coordonnées du point
   pct(2) = Sheets("Feuil Microregion").Cells(ligne, 4).Value
   pct(3) = 1 - (pct(1) + pct(2))
   If ligne Mod 5 = 2 Then 'un nouveau triangle
      periode = periode + 1
      region = 0
      text = "Periode n°" & periode
      Call Triangle(Ftriangle, pct, periode, "Feuil triangle2", text)
   End If
   region = region + 1
   Call ajouter_point(Ftriangle, pct, region)
Next ligne
End Sub

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub Triangle(Ftriangle As Shape, pct() As Double, No As Integer, NomFeuille As String, text As String)
 
Const Largeur = 150
Const Hauteur = ((3 / 4) * (Largeur ^ 2)) ^ (1 / 2) 'Pour que le triangle soit équilatéral
 
Dim Feuille As Worksheet
 
Dim lineL As Double, lineT As Double, LineW As Double, LineH As Double
Dim Coin1G As Double, coin1H As Double, Coin2G As Double, Coin2H As Double
Dim Forme1 As Shape, Forme2 As Shape
 
 
'coin en haut à gauche
Coin1G = Ltxt + (Largeur + Ltxt * 2) * ((No - 1) Mod 4)
coin1H = Htxt + (Hauteur + Htxt * 2) * (1 + Fix((No - 1) / 4))
'coin en bas à gauche
Coin2G = Coin1G
Coin2H = coin1H + Hauteur
 
Set Feuille = ThisWorkbook.Worksheets(NomFeuille)
 
 
Set Forme1 = _
Feuille.Shapes.AddShape(msoShapeRectangle, _
Coin1G, coin1H, Largeur, Hauteur) 'le rectange
Set Forme2 = _
Feuille.Shapes.AddShape(msoShapeIsoscelesTriangle, _
Coin1G, coin1H, Largeur, Hauteur) 'le triangle
 
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Forme2.Name)).Group
'on fusionne les 2 formes
 
'Pour le 1° %
'-----------------------------------------------
lineL = Coin1G + Largeur * pct(1)
lineT = Coin2H
LineW = lineL + Largeur * (1 - pct(1)) / 2
LineH = lineT + Hauteur * (pct(1) - 1)
Set Forme1 = Feuille.Shapes.AddLine(lineL, lineT, LineW, LineH)
Forme1.Line.ForeColor.RGB = RGB(120, 225, 34)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin2G, Coin2H, Ltxt, Htxt)
Call legende_ligne(Forme1, "0", 1)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin2G + Largeur, Coin2H, Ltxt, Htxt)
Call legende_ligne(Forme1, "100%", 1)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
 
'Pour le 2° %
'------------------------------------
lineL = Coin1G + Largeur * pct(2) / 2
lineT = coin1H + Hauteur * (1 - pct(2))
LineW = lineL + Largeur * (1 - pct(2))
LineH = lineT
Set Forme1 = Feuille.Shapes.AddLine(lineL, lineT, LineW, LineH)
Forme1.Line.ForeColor.RGB = RGB(43, 101, 226)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
 
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin2G + Largeur, Coin2H - Htxt, Ltxt, Htxt)
Call legende_ligne(Forme1, "0", 2)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin1G + Largeur / 2, coin1H, Ltxt, Htxt)
Call legende_ligne(Forme1, "100%", 2)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
'Pour le 3° %
'--------------------------------------------------------
lineL = Coin1G + Largeur * (1 - pct(3)) / 2
lineT = coin1H + Hauteur * pct(3)
LineW = Coin2G + Largeur * (1 - pct(3))
LineH = Coin2H
Set Forme1 = Feuille.Shapes.AddLine(lineL, lineT, LineW, LineH)
Forme1.Line.ForeColor.RGB = RGB(120, 0, 255)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin1G + Largeur / 2 - Ltxt, coin1H, Ltxt, Htxt)
Call legende_ligne(Forme1, "0", 3)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin2G, Coin2H - Ltxt, Ltxt, Htxt)
Call legende_ligne(Forme1, "100%", 3)
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
            '--------------------------------------------
'La zone de texte associée au triangle
Set Forme1 = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, Coin1G, coin1H - Htxt, Largeur, Htxt)
Forme1.TextFrame.Characters.text = text
Set Ftriangle = Feuille.Shapes.Range(Array(Forme1.Name, Ftriangle.Name)).Group
 
 
End Sub
 
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub legende_ligne(forme As Shape, text As String, No As Integer)
'Pour mettre en forme une forme
With forme
   .TextFrame.Characters.text = text
   .TextFrame.AutoSize = True
   Select Case No
      Case 1:     .TextFrame.Characters.Font.Color = RGB(120, 225, 34)
      Case 2:     .TextFrame.Characters.Font.Color = RGB(43, 101, 226)
      Case 3:     .TextFrame.Characters.Font.Color = RGB(120, 120, 120)
      Case 4:     .TextFrame.Characters.Font.Color = RGB(255, 0, 255)
      Case Else:  .TextFrame.Characters.Font.Color = RGB(20, 20, 34)
   End Select
   .Fill.Visible = msoFalse
   .Line.Visible = msoFalse
End With
End Sub
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub ajouter_point(Ftriangle As Shape, pct() As Double, noPoint As Integer)
Const TaillePt = 5
Dim lineL As Double, lineT As Double
Dim Point As Shape
Dim Feuille As Worksheet
Dim Nocouleur As Long
 
'la couleur du point
Select Case noPoint
   Case 1: Nocouleur = RGB(120, 225, 34)
   Case 2: Nocouleur = RGB(43, 101, 226)
   Case 3: Nocouleur = RGB(120, 120, 120)
   Case 4: Nocouleur = RGB(255, 0, 255)
   Case Else: Nocouleur = RGB(20, 20, 34)
End Select
 
Set Feuille = Worksheets(Ftriangle.TopLeftCell.Worksheet.Name)
'la feuille de la forme du triangle
 
'Ses coordonnées
lineL = Ftriangle.Left + (Ftriangle.Width - Ltxt) * ((pct(2) / 2) + pct(1))
lineT = Ftriangle.Top + Htxt + (Ftriangle.Height - 2 * Htxt) * (1 - pct(2))
 
'on le crèe et le met en forme
Set Point = Feuille.Shapes.AddShape(msoShapeOval, lineL - TaillePt / 2, lineT + TaillePt / 2, TaillePt, TaillePt)
Point.Line.Weight = TaillePt
Point.Line.ForeColor.RGB = Nocouleur
Point.Line.BackColor.RGB = Nocouleur
Set Ftriangle = Feuille.Shapes.Range(Array(Point.Name, Ftriangle.Name)).Group
 
'La légende
lineL = Ftriangle.Left
lineT = Ftriangle.Top + Htxt * ((noPoint + 1) / 2)
Set Point = Feuille.Shapes.AddTextbox(msoTextOrientationHorizontal, lineL, lineT, TaillePt, TaillePt)
Call legende_ligne(Point, CStr(noPoint), noPoint)
Point.TextFrame.Characters.Font.Bold = True
Set Ftriangle = Feuille.Shapes.Range(Array(Point.Name, Ftriangle.Name)).Group
End Sub

**zazaraignée** · 14/06/2006, 13h33

Je dois débrancher l'ordi pour un déménagement...
Je passe la main.

Bonne chance.

À bientôt.

[VBA-E]Effacer les shapes

Macros et VBA Excel

Discussions similaires

Partager

Partager