VBA - Effacer les formes automatiques [Résolu]

bubub64 10 Messages postés lundi 8 novembre 2010Date d'inscription 16 juin 2011 Dernière intervention - 9 nov. 2010 à 11:50 - Dernière réponse : cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention
- 15 nov. 2010 à 10:49
Bonjour à tous,

J'ai réalisé une macro qui trie des données pour me donner au final une liste d'angles (qui change suivant les données).

Pour traiter ces angles, j'ai mis en place un bouton, qui lorsque l'on clique dessus, contruit dans une autre feuille un cercle avec la répartition de ces angles autour de celui-ci. (Merci encore à Jordane pour la soluce)

Tout marche parfaitement sauf pour une chose. Lorsque je veux effacer ce "graphique" avec une macro, j'ai une erreur :( Il ne trouve pas les droites tracées. Ya t-il un moyen simple d'effcer ces courbes/ cercles/ droite?

Pour le moment j'ai contourné le problème en effacant la feuille et en la re-créant...

Merci d'avance.
Afficher la suite 

19 réponses

Répondre au sujet
jordane45 20570 Messages postés mercredi 22 octobre 2003Date d'inscriptionContributeurStatut 21 avril 2018 Dernière intervention - 9 nov. 2010 à 12:33
+3
Utile
Bonjour,

peux tu essayer ce code ?
en gros, il cherche les formes dont le nom contient LINE et si il les trouve.. les supprime.

Sub Macro1()
  
   nbshap = ActiveSheet.Shapes.Count 'nombre de formes dans la page
   For i = 1 To nbshap 'boucle sur chaque "forme"
        NomShap = ActiveSheet.Shapes(i).Name 'nom de la forme
        If NomShap Like "Line*" Then 'si contient LINE...
            ActiveSheet.Shapes(i).Delete ' suppression
        End If 'suite
   Next
   
End Sub


Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de jordane45
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 9 nov. 2010 à 16:24
+3
Utile
Salut,

Jordane à tres bien repondu mais permettez moi quand même de poster une autre solution:

donc pour votre culture et notamment celle de Jordane qui s'implique beaucoup

Cette methode s'appuie sur la collection "Shapes" contenu dans une feuille:

Sub EffacerObjetLigne()
  Dim ObjetShape As Shape 'declaration d'une variable objet de type Shape
    For Each ObjetShape In ActiveSheet.Shapes 'pour chaque objet shape de la colection shapes de la feuille active
        If ObjetShape.Type = msoLine Then 'si l'objet est une ligne alors
            ObjetShape.Delete 'on le suprime
        End If
    Next
End Sub


A+
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de bigfish_le vrai
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 9 nov. 2010 à 16:54
+3
Utile
re,

bubu64, utilise l'enregistreur de macro et fait l’opération d'enlever le fond à la main puis vas voir le code enregistré.

Jordanne, si tu regardes bien dans l'aide "Shapes collection" il y à un lien "Utilisation de formes (objets dessinés)"

puis dans l'aide ouverte via le lien, tu descends jusqu'au titre : Boucle sur une collection Shapes ou ShapeRange

A+
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de bigfish_le vrai
bubub64 10 Messages postés lundi 8 novembre 2010Date d'inscription 16 juin 2011 Dernière intervention - 15 nov. 2010 à 10:42
+3
Utile
Bon ben a force de bidouiller j'ai trouvé ^^

Dim aShape As Shape

For Each aShape In ActiveSheet.Shapes

If aShape.Type = msoTextBox Then

aShape.Delete

End If

Next

Bonne journée :)
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de bubub64
bubub64 10 Messages postés lundi 8 novembre 2010Date d'inscription 16 juin 2011 Dernière intervention - 9 nov. 2010 à 14:12
0
Utile
Rapide et efficace :)

Merci encore Jordane et bonne après midi!
Commenter la réponse de bubub64
bubub64 10 Messages postés lundi 8 novembre 2010Date d'inscription 16 juin 2011 Dernière intervention - 9 nov. 2010 à 16:43
0
Utile
Bonjour Bigfish,

Merci, ta méthode marche aussi et ca me permet aussi de voir plusieur facon de résonner :)

Tenez j'ai une nouvelle question (je commence a avoir honte)...
Lorsque je crée mon cercle :

posX = 100 'coodonnées LEFT du cercle
posY = 100 'coodonnées TOP du cercle
wd = 200 ' Largeur
ht wd ' Hauteur ( Largeur)

ActiveSheet.Shapes.AddShape(msoShapeOval, posX, posY, wd, ht).Select


J'aimerai que ce soit un cercle SANS remplissage...
J'ai trouvé un bout de code sur un forum:

Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 1.5
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

Mais ca ne marche pas :(


Avez vous le code pour me mettre ce cercle sans remplissage?

Merci encore une fois pour le tps que vous me concacrez. Passez une bonne fin de journée.
Commenter la réponse de bubub64
jordane45 20570 Messages postés mercredi 22 octobre 2003Date d'inscriptionContributeurStatut 21 avril 2018 Dernière intervention - 9 nov. 2010 à 16:44
0
Utile
Bonjour,
Arf..; je cherchais justement ça : ObjetShape.Type = msoLine
mais bon.. j'ai voulu répondre rapidement...(avant d'aller manger ).
Merci pour l'info.

au passage j'avais regardé dans l'aide mais je n'ai pas trouvé le .TYPE
Où as tu trouvé cette information ?

Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI
Commenter la réponse de jordane45
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 9 nov. 2010 à 16:58
0
Utile
re,

bubu64, l'option doit être celle-ci : .Fill.Visible = msoFalse

A+
Commenter la réponse de bigfish_le vrai
jordane45 20570 Messages postés mercredi 22 octobre 2003Date d'inscriptionContributeurStatut 21 avril 2018 Dernière intervention - 9 nov. 2010 à 17:16
0
Utile
Bonjour,
utilises l'enregistreur de macro en créeant à la main un cercle.
tu obtiendras le code souhaité. ^^

Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI
Commenter la réponse de jordane45
jordane45 20570 Messages postés mercredi 22 octobre 2003Date d'inscriptionContributeurStatut 21 avril 2018 Dernière intervention - 9 nov. 2010 à 18:00
0
Utile
Bonjour,
arf.. je n'avais pas vu qu'il y avait déjà eu la meme réponse..

et merci pour l'info bigfish_le vrai. je n'avais pas vu

Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI
Commenter la réponse de jordane45
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 10 nov. 2010 à 11:08
0
Utile
Bonjour,
Je profite de ce post, qui rejoint la question que j'ai à poser.
Il s'agit d'image à la place de Line.
J'insére une image et je supprime une autre image suivant un résultat.Elle n'est jamais à la même ligne.
J'ai fait une macro qui fonctionne. Problème quand il n'y a pas d'image: bug. J'ai mis On Error Resume Next et cela fonctionne de nouveau. Ma question a-t-on une autre alternative que cette méthode.
Voici ma macro:

Sub deletecoupe() 'suppression de la dernière image
    On Error Resume Next
    Set myDocument = Worksheets(1) 'Sélection de la feuille
    myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton etc.)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'on protège tout les Objets
    Selection.Cut 'on supprime l'objet qui n'a pas été protégé (déverrouillé)
    ActiveSheet.Unprotect 'on déprotège tout les Objets
End Sub

C'est juste pour coder plus propre
Merci
@+Le Pivert
Commenter la réponse de cs_Le Pivert
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 nov. 2010 à 11:21
0
Utile
Salut Le Pivert,

étonnante question venant d'une personne aussi chevronnée

bah quand on est trop dedans on voit plus l’évidence

pour ma part gerer les erreurs au lieu d'utiliser du conditionnel n'est pas du tout une faute de gout. D'autan que le conditionnel ne gere pas tous les cas mais seulement ceux au quels on à pensés. alors qu'un "On Error Resume Next" bien placé permet de gérer toutes les erreurs. Ceci n'est que mon avis

maintenant pour repondre à ta question:

Set myDocument = Worksheets(1) 'Sélection de la feuille
    If Not myDocument.Shapes.Count =0 Then
       myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton etc.)
    End If


Ceci devrait faire l'affaire.

A+
Commenter la réponse de bigfish_le vrai
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 10 nov. 2010 à 12:09
0
Utile
Merci bigfisf_levrai pour ta réponse. Mais j'ai un bug sur cette ligne quand il n'y a pas d'image:
Selection.Cut 'on supprime l'objet qui n'a pas été protégé (déverrouillé)

j'ai essayé ton code de différentes manière, mais je n'arrive pas à le caser.
Je suis d'accord avec toi pour le
On Error Resume Next
sans toutefois l'employer à tout bout de champs, car cela cache certaines erreurs de codage.Mais dans certaines conditions, il se révèle très utile, n'en déplaise aux puristes.

@+ Le Pivert
Commenter la réponse de cs_Le Pivert
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 nov. 2010 à 14:58
0
Utile
arf je n'ai pas vu cette ligne...

par contre la... j'aurai besoin d'une explication !

si tu as selectionné tout les shapes pour les protégés comment et pourquoi vouloir effacer ceux qui ne sont pas protégés puisque justement tu viens de tous les protégés ?
Autrement dit à quel moment et comment n'as tu pas protégé la derniere image ???

A+
Commenter la réponse de bigfish_le vrai
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 10 nov. 2010 à 15:17
0
Utile
Objectif:
Mettre une coupe à côté du nom du gagnant.
Quand j'insére mon image je la déverouille en même temps pour la remplacer la fois suivante, car elle ne sera pas à la même place.
La macro RechercheMot détermine une position de ligne(pos)pour pouvoir insérer une image à droite de ce mot.
Sub Action()
Fichier = ActiveWorkbook.Path & "" & "coupe.jpg" 'chemin du fichier image
deletecoupe 'suppression de la dernière image
RechercheMot
Range("I" & pos).Select 'sélection de la cellule
     ActiveSheet.Pictures.Insert( _
        Fichier). _
        Select 'insertion de l'image
   Selection.Locked = False ' on déverrouille la protection de l'image
   Cadre_image ' on met l'image au centre le cellule avec un cadre
End Sub

Sub deletecoupe() 'suppression de la dernière image
    On Error Resume Next
    Set myDocument = Worksheets(1) 'Sélection de la feuille
    myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton etc.)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'on protège tout les Objets
    Selection.Cut 'on supprime l'objet qui n'a pas été protégé (déverrouillé)
    ActiveSheet.Unprotect 'on déprotège tout les Objets
End Sub


J'ai essayé ton code avec des MsgBox "pas d'image" ou alors "image"
Cela fonctionne mais dès que je mets
Selection.Cut ça bug
@+ Le Pivert
Commenter la réponse de cs_Le Pivert
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 nov. 2010 à 17:02
0
Utile
a la vue de ce que tu veux faire ce que je t'ai donné ne sert à rien !

par contre j'ai testé ton code si une image n'ai effectivement pas verrouillée elle est bien effacée.

donc ton code fonctionne

je ne vois pas désolé

A+
Commenter la réponse de bigfish_le vrai
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 10 nov. 2010 à 17:33
0
Utile
Je te remercie bigfish_levrai, mais j'ai enfin trouvé.
Ce n'est pas très important, mais c'est ce post qui m'a fait poser la question.
Donc voici la solution, je ne pense pas que cela intéresse beaucoup de monde, je la donne quand même:

Sub deletecoupe() 'suppression de la dernière image
  Set myDocument = Worksheets(1) 'Sélection de la feuille
    myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton etc.)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'on protège tout les Objets
  If Selection.Locked = False Then
    Selection.Cut 'on supprime l'objet qui n'a pas été protégé (déverrouillé)
    End If
    ActiveSheet.Unprotect 'on déprotège tout les Objets
End Sub


@+Le Pivert
Commenter la réponse de cs_Le Pivert
bubub64 10 Messages postés lundi 8 novembre 2010Date d'inscription 16 juin 2011 Dernière intervention - 15 nov. 2010 à 09:52
0
Utile
Re bonjour après ce long et bon week end :)

Bon je suis toujours avec ma petite macro, qui fonctionne du tonnerre grace a vous.

Ma question est la suivante, la macro que vous m'avez donné efface bien les lignes comme je voulais, sauf que entre tps j'ai modifié un peu l'affiche pour qu'a chaques ligne qui se crée, une textbox apparait au bout de la ligne en s'incrémentant:


********************************************
For a = 1 To b
rad = Cells(3, a).Value

'Coordonnées du point de destination
EndX = ((Cos(rad) * r) + startX)
EndY = (-(Sin(rad) * r) + startY)

'expression.AddLine(BeginX, BeginY, EndX, EndY)
ActiveSheet.Shapes.AddLine(startX, startY, EndX, EndY).Select

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, EndX, EndY, _
18#, 24#).Select
Application.CutCopyMode = False
Selection.Characters.Text = a
With Selection.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With


*********************************************

Bref, ma question est la suivante, quelle est la commande pour effacer aussi les textbox? J'ai regardé dans l'aide mais j'ai rien trouvé :(

J'en reste a :
*****************
Dim ObjetShape As Shape
For Each ObjetShape In ActiveSheet.Shapes
If ObjetShape.Type = msoLine Then
ObjetShape.Delete
End If
If ObjetShape.Type = msoTextBox Then'si l'objet est une textbox alors
ObjetShape.Delete 'on le suprime
End If
Next
********************

Merci d'avance pour l'aide encore une fois, et bonne journée!
Commenter la réponse de bubub64
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 15 nov. 2010 à 10:49
0
Utile
Tu peux te servir de ma méthode qui supprime tous les objets non verrouillés. A la création de ton TextBox tu le déverrouille manuellement : Clic droit- Format de contrôle- Protection, tu décoches Verrouilé.
Ou par code lors de la création du TextBox en mettant:
 Selection.Locked = False ' on déverrouille la protection du TextBox


Ensuite pour supprimer les TextBox non verrouillés mettre cette macro:

Sub deleteobjet() 'suppression des objets non verrouillés
  Set myDocument = Worksheets(1) 'Sélection de la feuille
    myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton, textBox etc.)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'on protège tout les Objets
  If Selection.Locked = False Then
    Selection.Cut 'on supprime l'objet qui n'a pas été protégé (déverrouillé)
    End If
    ActiveSheet.Unprotect 'on déprotège tout les Objets
End Sub

@+ Le Pivert
Commenter la réponse de cs_Le Pivert

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.