pb VBA et ShapesRésolu

Question

Bonjour ! 
 
voilà mon pb :  
 
je fais un tableau basique avec dans deux colonnes des chiffres. Ma troisième colonne est une soustraction : chiffres deuxième colonne - chiffres première colonne 
Si il y a eu une hausse les cellules de ma troisième colonne se remplissent par une flèche vers le haut (si baisse => flèche vers le bas...) 
 
Lorsque je change les chiffres de mes colonnes et que je relance la macro mes nouvelles flèches s'inscrivent sur les anciennes. Pour palier a ce pb j'ai écris : 
 
Sheets("progressions" ).Activate 
ActiveSheet.Shapes.SelectAll 
Selection.ShapeRange.Delete 
 
Le pb c'est que j'efface aussi toutes les autres formes automatiques qui sont dans ma feuille (bouton de commande pour exécuter les macros par exemple) 
 
Comment faire pour n'effacer que les flèches ? 
 
Merci d'avance si vous avez une solution

jrivet · Accepted Answer

Salut,

Lorsque je t'écris

ActiveSheet.Shapes.Range(Array("TextBox2", "TextBox1")).Select
Selection.Delete

Et que je te dis :  Tu dois mettre les nom exact

Et que ensuite tu nous montre du code ou tes shapes s'appelle "rouge" & i

.... Je te laisse devinner la suite....

LES NOM EXACT SONT NECESSAIRES POUR SUPPRIMER

@+, Julien
Pensez: Règlement/STRONG>

tof008 · Answer

Hello!
Pour effacer seulement le contenu des cellules, j'utilise ca :  Selection.ClearContents
Je ne sais pas si ca marchera pour toi...

         (Si la réponse vous convient, appuyez sur réponse acceptée...).

                           Noubliez pas de lire le REGLEMENT

jrivet · Answer

Salut,

Ceci supprime TextBox1 et TextBox2

ActiveSheet.Shapes.Range(Array("TextBox2", "TextBox1")).Select
Selection.Delete

Il te suffit donc de te préparer un tableau avec tout les nom des fleches a supprimer (pas tester) ca devrait fonctionner

@+, Julien
Pensez: Règlement/STRONG>

cs_inea · Answer

Hélas le ClearContents ne marche pas non plus puisque dans mes cellules rien n'est écrit, il y a juste ces formes automatiques (flèches) qui ne s'effacent pas avec le clear contents

En tout cas merci quand meme

cs_inea · Answer

Merci Julien


je vais essayer et te dire si je m'en sors :o)

cs_inea · Answer

Bon voilà j'ai tenté un truc :
quand les flèches montent je les ai appellées "vert"
quand les flèches stagnent je les ai appellées "bleu"
quand les flèches descendent je les ai appellées "rouge"

ensuite j'ai fait :
Sheets("progressions").Activate
ActiveSheet.Shapes.Range(Array("bleu", "rouge", "vert")).Select
Selection.Delete

ça marche mais j'ai plusieurs "bleu" et plusieurs "vert", or là ça ne m'efface que les premiers "bleu" et "vert"
 Est ce que tout le monde suit ?

jrivet · Answer

Tu n'as pas pu appeler deux fleche par le meme nom.

Tu dois mettre les nom exact

@+, Julien
Pensez: Règlement/STRONG>

tof008 · Answer

Et si tu fais une boucle sur ta selection et qque tu efface pour chaque cellule?

         (Si la réponse vous convient, appuyez sur réponse acceptée...).

                           Noubliez pas de lire le REGLEMENT

cs_inea · Answer

Je vous met un extrait de la boucle qui fait les flèches pour que vous voyiez mieux
je l'ai changé pour que ça appelle les flèches par bleu & un numéro de ligne, comme ça je pourrais peut etre essayer de supprimer tout ce qui est shape et qui commence par bleu
Croyez vous que c'est possible ?

For i = numdeb To numL
    prog = Cells(i, 7) - Cells(i, 6)
    Cells(i, 8).Activate
    hauteur = ActiveCell.Top
    bas = ActiveCell.Height + hauteur
    milieu = ActiveCell.Height / 2 + hauteur
    gauche = ActiveCell.Left
    largeur = ActiveCell.Width / 3
    diag = ActiveCell.Height
     
   
  If prog = 0 Then
  'flèche horizontale  , bleu
   ActiveSheet.Shapes.AddLine(gauche, milieu, gauche + largeur, milieu).Select
   Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
   Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
   Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
   Selection.ShapeRange.Line.ForeColor.SchemeColor = 18
   Selection.ShapeRange.Line.Visible = msoTrue
   Selection.Name = "bleu" & i
 
  ElseIf prog > 0 Then
  'flèche vers le haut , verte
   ActiveSheet.Shapes.AddLine(gauche, bas - 2, gauche + diag, bas - 12).Select
   Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
   Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
   Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
   Selection.ShapeRange.Line.ForeColor.SchemeColor = 17
   Selection.ShapeRange.Line.Visible = msoTrue
   Selection.Name = "vert" & i
    
    
  Else
        
  'flèche vers le bas rouge
   ActiveSheet.Shapes.AddLine(gauche, hauteur + 2, gauche + diag, hauteur + 12).Select
   Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
   Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
   Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
   Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
   Selection.ShapeRange.Line.Visible = msoTrue
   Selection.Name = "rouge" & i
    
  End If
    
   Next i
 end sub

cs_inea · Answer

Au lieu d'appeller mes flèches bleu et etc... j'ai appellé "line"&numéro de ligne


J'ai tenté ça après :



Sheets("progressions").Activate
If Left(Shape.Name, 4) = "Line" Then Shape.Delete



mais sans succès

cs_inea · Answer

Vi evidemment ça marche de suite mieux....


dommage que je ne sois pas arivée a faire une boucle du style 

For Each fleches In ActiveSheet.Shapes 
   If fleches.Name Like "line*" Then ActiveSheet.Shape.Select
   Selection.Delete
   Next fleches

pour toutes les supprimer (là ça va j'en ai 16 donc je peux écrire les noms mais imagine si j'en avais 1000)

en tout cas merci !!

jrivet · Answer

Pourquoi tu ne stocke pas les noms lorsque tu cree tes controles. J'ai creer un classeur avec 10 textbox et pour les effacer j'ai fait comme suit. Dim NomObjets() As Variant Dim i As Integer ReDim NomObjets(0) For i = 1 To 10 NomObjets(i - 1) = "TextBox" & i If i <> 10 Then ReDim Preserve NomObjets(UBound(NomObjets) + 1) Next ActiveSheet.Shapes.Range(NomObjets).Delete Coloration syntaxique automatique [AFCK] A toi maintenant avec ce principe la d'adapter a tes besoins (en tout cas si tu estime que ton probleme est resolu, pense au reponse acceptée sur les posts qui ont pu t'aider) @+, Julien Pensez: Règlement/STRONG>

cs_inea · Answer

Merci pour cette superbe boucle mais je crains que ce ne soit trop pour mon faible niveau en vba

jrivet · Answer

Salut,


Si tu pars défaitiste t'es pas près d'aller plus loin.


Il te suffit en fait de faire a la fin de ta boucle ou tu donne les nom au selection
Selection.Name =  "bleu" & i ou 
Selection.Name = "rouge" & i Etc....

D'ajouter ensuite ces deux lignes juste avant le next i:

NomObjets( UBound (NomObjets))  = Selection.Name
If i <> NumL Then ReDim Preserve NomObjets(UBound(NomObjets) + 1)

Avant la boucle:
ReDim NomObjets(0)

Et variable de ta feuille : Dim NomObjets() As Variant 

@+, Julien
Pensez: Règlement/STRONG>

cs_inea · Answer

En fait j'ai fait plus simple (disons de mon niveau ) et cela fonctionne
Sub fleche()



Dim numL As Integer
Dim numdeb As Integer
Dim NomObjets As Variant
Dim j As Integer



  Sheets("progressions").Activate
  Range("debliste").Select
  numdeb = ActiveCell.Row
  Selection.End(xlDown).Select
  numL = ActiveCell.Row
 
 'suppression des anciennes flèches
    For j = numdeb To numL
    Cells(j, 8).Activate
    NomObjets = "line" & j
    ActiveSheet.Shapes.Range(NomObjets).Delete
    Next j

Pb VBA et Shapes

15 réponses

Votre réponse

Discussions similaires