Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel suppression objets

suppression objets

2 réponses
Avatar
andre
Bonjour,
dans un program j'ai 2 macros une a l'ouverture du classeur
la 2 a la fermeture du classeur
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("feuil1").Select
ActiveSheet.Protect DrawingObjects = True, Contents = True, Scenarios
= True
ActiveSheet.DrawingObjects.Select
Selection.Delete
ActiveSheet.Unprotect
End Sub

mon probleme (a la fermeture) est qu'il me supprime tous les objets
dela feuille (normal)donc je choisis de ne pas enregistrer et a
l'ouverture je les retrouve c'est pas genial
donc je voudrais que seul les objets de la colonne "E" soient supprime
j'ai essayé avec l'enregistreur meme probleme
mes 2 objets de reference sont en A3 et A4 et ils se collent
a l'ouverture du classeur merci bon dimanche (j'ai été un peu long)

Private Sub Workbook_Open()
Range("D7").EntireRow.Select
Do Until IsEmpty(ActiveCell.Value)
nb = ActiveCell.Row
If Range("D" & nb).Value > Range("B1").Value Then
ActiveSheet.Shapes("En Cours").Select
Selection.Copy
Range("E" & nb).Select
ActiveSheet.Paste
Selection.Locked = False
Else
ActiveSheet.Shapes("En Retard").Select
Selection.Copy
Range("E" & nb).Select
ActiveSheet.Paste
Selection.Locked = False
End If
ActiveCell.Offset(1, 0).EntireRow.Select
Loop

End Sub

--
andre
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Jean-François Aubert
Salut André,
Il faut nommer tes Shapes, quand tu les crées (un nom différent à chaque
shape, c'est mieux).
A la fermeture, tu boucles sur les shapes, et supprimes ceux dont leur angle
supérieur gauche est dans la colonne 5 ( col E)

Private Sub Workbook_Open()
Range("D7").EntireRow.Select
Do Until IsEmpty(ActiveCell.Value)
nb = ActiveCell.Row
If Range("D" & nb).Value > Range("B1").Value Then
ActiveSheet.Shapes("En Cours").Copy
Selection.Copy
Range("E" & nb).Select
ActiveSheet.Paste
Selection.Locked = False
Selection.Name = Selection.Top & Selection.Left '<<<<<
Else
ActiveSheet.Shapes("En Retard").Select
Selection.Copy
Range("E" & nb).Select
ActiveSheet.Paste
Selection.Locked = False
Selection.Name = Selection.Top & Selection.Left '<<<<<
End If
ActiveCell.Offset(1, 0).EntireRow.Select
Loop
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("feuil1").Select
ActiveSheet.Protect DrawingObjects = True, Contents = True, Scenarios =
True

Dim Truc As Shape
For Each Truc In ActiveSheet.Shapes
If ActiveSheet.Shapes(Truc.Name).TopLeftCell.Column = 5 Then
Truc.Delete
End If
Next Truc

End Sub


--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"andre" a écrit dans le message de news:

Bonjour,
dans un program j'ai 2 macros une a l'ouverture du classeur
la 2 a la fermeture du classeur
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("feuil1").Select
ActiveSheet.Protect DrawingObjects = True, Contents = True, Scenarios =
True
ActiveSheet.DrawingObjects.Select
Selection.Delete
ActiveSheet.Unprotect
End Sub

mon probleme (a la fermeture) est qu'il me supprime tous les objets dela
feuille (normal)donc je choisis de ne pas enregistrer et a l'ouverture je
les retrouve c'est pas genial
donc je voudrais que seul les objets de la colonne "E" soient supprime
j'ai essayé avec l'enregistreur meme probleme
mes 2 objets de reference sont en A3 et A4 et ils se collent
a l'ouverture du classeur merci bon dimanche (j'ai été un peu long)

Private Sub Workbook_Open()
Range("D7").EntireRow.Select
Do Until IsEmpty(ActiveCell.Value)
nb = ActiveCell.Row
If Range("D" & nb).Value > Range("B1").Value Then
ActiveSheet.Shapes("En Cours").Select
Selection.Copy
Range("E" & nb).Select
ActiveSheet.Paste
Selection.Locked = False
Else
ActiveSheet.Shapes("En Retard").Select
Selection.Copy
Range("E" & nb).Select
ActiveSheet.Paste
Selection.Locked = False
End If
ActiveCell.Offset(1, 0).EntireRow.Select
Loop

End Sub

--
andre




Avatar
andre
andre à dit
jean francois
effectivement
ils sont nommés mes shapes
je vais essayer mais pas avant demain
je te dirai
bonne soiree
merci

--
andre