Shape Delete

[Yldie]

Bonjour le forum,

Chers Xldnautes, je vous serais très reconnaissant de bien vouloir vous pencher sur mon pb qui pour vous ne devrait poser aucun souci.....
Merci encore

YLDIE

 

[skoobi]

Re : Shape Delete

Bonjour Yldie,

voici un exemple:

Sub delete()
  Dim Shp As Shape
  Dim C As Range, DerLig As Long
  DerLig = [A65536].End(xlUp).Row
  For Each C In Range("A2:A" & DerLig)
    If Range("B" & C.Row) = "" Then
      ActiveSheet.Shapes("Ellipse " & C.Row - 1).delete
    End If
  Next
End Sub

Si tu as besoin d'explication, n'hésite pas.

 

[Yldie]

Re : Shape Delete

Merci SKOOBI,

seul hic, c'est que lorsque je remets un écrit, je retape "TAXI" et que j'exécute la macro, l'ellipse ne revient pas, aussi pourrais-tu me dire s'il est possible de créer un code permettant de supprimer (delete) les ellipses selon les conditions que j'ai formulé et a contrario de voir réapparaître ces mêmes ellipses si ces mêmes conditions sont à nouveau rempli.....? En tout cas, quel talent, je te remercie d'avance !!!

YLDIE

 

[Yldie]

Re : Shape Delete

Est-ce que ce code pourrait fonctionner !?!?
Merci SKOOBI, chers XLDnautes

YLDIE

 

[skoobi]

Re : Shape Delete

Re,

je te suggeres de rendre l'ellipse invisible, ou pas, plutôt que de la détruire:

Sub delete()
  Dim Shp As Shape
  Dim C As Range, DerLig As Long
  DerLig = [A65536].End(xlUp).Row
  For Each C In Range("A2:A" & DerLig)
      ActiveSheet.Shapes("Ellipse " & C.Row - 1).Visible = Range("A" & C.Row) <> ""
  Next
End Sub

Edit: petite précision: le chiffre indiqué à la fin du nom de l'ellipse a un lien direct avec la ligne sur laquelle elle se trouve.
Exemple:

"ellipse 1" doit se trouver sur la ligne 2.
"ellipse 2" doit se trouver sur la ligne 3.
etc...

 

[Yldie]

Re : Shape Delete

ça bug !!!!
Merci SKOOBI de bien vouloir m'indiquer ce qui cloche, encore Great Thanks !!!

J'en apprends tous les jours

YLDIE

 

[skoobi]

Re : Shape Delete

Re,

visiblement tu n'as pas lu mon edit:

Edit: petite précision: le chiffre indiqué à la fin du nom de l'ellipse a un lien direct avec la ligne sur laquelle elle se trouve.
Exemple:

"ellipse 1" doit se trouver sur la ligne 2.
"ellipse 2" doit se trouver sur la ligne 3.
etc...

Edit:
Voici un autre code qui ne tiens pas compte du nom des ellipses. Le code cherche la ligne sur laquelle se trouve l'ellipse:

Sub delete()
  Dim Shp As Shape
  Dim C As Range, DerLig As Long
  DerLig = [A65536].End(xlUp).Row
  For Each C In Range("A2:A" & DerLig)
    For Each Shp In ActiveSheet.Shapes
      If Shp.TopLeftCell.Row = C.Row Then Shp.Visible = Range("A" & C.Row) <> ""
    Next
  Next
End Sub

 

[Yldie]

Re : Shape Delete

Génial ton code SKOOBI, je suis super content, ça répond exactement à ma demande, MERCI !!!!!

YLDIE

 

[Yldie]

Re : Shape Delete

J'ai un dernier bug, au niveau du code : Erreur de compilation Projet ou bibliothèque introuvable [A65536]

Sub DELETER()
Dim Shp As Shape
Dim C As Range, DerLig As Long
DerLig = [A65536].End(xlUp).Row
For Each C In Range("J6:J22" & DerLig)
For Each Shp In ActiveSheet.Shapes
If Shp.TopLeftCell.Row = C.Row Then Shp.Visible = Range("J" & C.Row) <> ""
Next
Next
End Sub

Comment faire pour que ça marche !?!?!? Merci de bien vouloir m'aider pour ce pb

A bientôt....merci

 

[Pierrot93]

Re : Shape Delete

Bonjour Yldie, Skoobi

A priori cette ligne devrait fonctionner sans problème :

DerLig = [A65536].End(xlUp).Row

par contre celle-ci :

For Each C In Range("J6:J22" & DerLig)

devrait être modifiée ainsi :

For Each C In Range("J6:J" & DerLig)

bonne journée
@+

 

[Yldie]

Re : Shape Delete

Dernier souci et après ce sera parfait, une fois mes ellipses (visibles ou invisibles selon.....), je dois pouvoir copier celles visibles et les coller dans une autre feuille, mais là nouveau bug, ci-joint le code :

Sub Macro4()

Range("A1").Select
ActiveSheet.Unprotect ("YLDIE")
Sheets("roulement 1").Select
ActiveSheet.Shapes.Range(Array("Oval 7", "Oval 10", "Oval 11", "Oval 12" _
, "Oval 13", "Oval 14", "Oval 15", "Oval 16" _
, "Oval 17", "Oval 18", "Oval 19", "Oval 20" _
, "Oval 21", "Oval 22", "Oval 23", "Oval 24")).Select
Selection.Copy
Sheets("scolaires").Select
ActiveSheet.Paste
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("K7").Select
End Sub

Ma question est donc la suivante, comment remplacer ce bout de code par une formule imparable qui va automatiquement sélectionner les ellipses visibles ?

Merci d'avance !!!!

Yldie

 

[kjin]

Re : Shape Delete

Bonjour,
Avec ce que je comprends (le principe a été donnée plus haut)

Sub copie()
Sub copie()
Dim Shp As Object
For Each Shp In ActiveSheet.Shapes
    If Shp.Visible = True And Shp.Name Like "Oval*" Then
    Shp.Copy
    Sheets("Feuil2").Activate
    Cells(x + 10, 1).Select
    Sheets("Feuil2").Paste
    x = x + 1
    End If
Next
End Sub

A+
kjin

 

[Yldie]

Re : Shape Delete

Merci Kjin,

Très sympa à toi, j'avoue que pour l'instant j'ai du mal à intégrer ton code à ma pièce jointe, ça bug, je te joins à nouveau mon fichier, merci d'avance !!!

YLDIE

 

[kjin]

Re : Shape Delete

Bonjour,
Là, il faudra être plus clair en décrivant précisément le principe !
Sélectionner un objet ne veut rien dire hormis si on click droit dessus
En outre, s'agit-il de copier tous les objets ou juste celui "sélectionné" (contradictions dans tes notes), la procédure vient-elle à la suite d'une autre, est-elle associée au bouton copier/coller...
A+
kjin

 

[Yldie]

Re : Shape Delete

Merci beaucoup KJIN,

En fait le code qui fonctionne sur ma feuille et que j'ai pu transposer sur un classeur beaucoup plus fouillé est le suivant :

Sub copie()
Dim Shp As Object
Sheets("Feuil1").Select
For Each Shp In ActiveSheet.Shapes
If Shp.Visible = True And Shp.Name Like "Oval*" Then
Shp.Copy
Sheets("Feuil2").Activate
Cells(x + 10, 1).Select
Sheets("Feuil2").Paste
x = x + 1
End If
Next
End Sub

Vraiment super sympa à toi, ça m'aura permis de comprendre encore plus la signification de certains termes (complexe quand on débute le VBA....).
Great Thanks KJIN !!!!

YLDIE