VBA - Effacer les formes automatiquesRésolu

Question

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.

jordane45 · Accepted Answer

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

bubub64 · Answer

Rapide et efficace :)

Merci encore Jordane et bonne après midi!

bigfish_le vrai · Answer

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+

bubub64 · Answer

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.

jordane45 · Answer

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

bigfish_le vrai · Answer

re,

bubu64, utilise l'enregistreur de macro et fait l&#8217;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+

bigfish_le vrai · Answer

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

jordane45 · Answer

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

jordane45 · Answer

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

cs_Le Pivert · Answer

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

bigfish_le vrai · Answer

Salut Le Pivert,

étonnante question venant d'une personne aussi chevronnée 

bah quand on est trop dedans on voit plus l&#8217;é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+

cs_Le Pivert · Answer

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

bigfish_le vrai · Answer

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+

cs_Le Pivert · Answer

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

bigfish_le vrai · Answer

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+

cs_Le Pivert · Answer

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

bubub64 · Answer

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!

bubub64 · Answer

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 :)

cs_Le Pivert · Answer

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

VBA - Effacer les formes automatiques

19 réponses

Votre réponse

Discussions similaires