Pb VBA et Shapes [Résolu]

cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 11:10 - Dernière réponse : cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention
- 26 juil. 2006 à 16:08
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
Afficher la suite 

Votre réponse

15 réponses

Meilleure réponse
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juil. 2006 à 14:34
3
Merci
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>

Merci jrivet 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 99 internautes ce mois-ci

Commenter la réponse de jrivet
tof008 707 Messages postés jeudi 5 mai 2005Date d'inscription 5 janvier 2010 Dernière intervention - 26 juil. 2006 à 11:18
0
Merci
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 
Commenter la réponse de tof008
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juil. 2006 à 11:25
0
Merci
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>
Commenter la réponse de jrivet
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 11:26
0
Merci
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
Commenter la réponse de cs_inea
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 11:27
0
Merci
Merci Julien


je vais essayer et te dire si je m'en sors :o)
Commenter la réponse de cs_inea
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 11:35
0
Merci
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 ?
Commenter la réponse de cs_inea
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juil. 2006 à 11:43
0
Merci
Tu n'as pas pu appeler deux fleche par le meme nom.

Tu dois mettre les nom exact

@+, Julien
Pensez: Règlement/STRONG>
Commenter la réponse de jrivet
tof008 707 Messages postés jeudi 5 mai 2005Date d'inscription 5 janvier 2010 Dernière intervention - 26 juil. 2006 à 11:44
0
Merci
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 
Commenter la réponse de tof008
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 12:05
0
Merci
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
Commenter la réponse de cs_inea
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 14:26
0
Merci
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
Commenter la réponse de cs_inea
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 15:24
0
Merci
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 !!
Commenter la réponse de cs_inea
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juil. 2006 à 15:39
0
Merci
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 

 

<small> Coloration syntaxique automatique [AFCK]</small>
       

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>
Commenter la réponse de jrivet
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 15:48
0
Merci
Merci pour cette superbe boucle mais je crains que ce ne soit trop pour mon faible niveau en vba
Commenter la réponse de cs_inea
jrivet 7401 Messages postés mercredi 23 avril 2003Date d'inscription 6 avril 2012 Dernière intervention - 26 juil. 2006 à 15:57
0
Merci
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>
Commenter la réponse de jrivet
cs_inea 23 Messages postés vendredi 21 juillet 2006Date d'inscription 3 octobre 2008 Dernière intervention - 26 juil. 2006 à 16:08
0
Merci
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
Commenter la réponse de cs_inea

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.