Supprimer un shape avec le même nom sur plusieurs onglets

anakin_74 35 Messages postés mercredi 9 octobre 2013Date d'inscription 13 août 2017 Dernière intervention - 12 août 2017 à 22:19 - Dernière réponse : yg_be 4398 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 23 janvier 2018 Dernière intervention
- 13 août 2017 à 23:27
Bonjour aux pro de VBA.

J'ai un soucis.

J'ai un menu déroulant sur un onglet de 12 positions sur lequel en double cliquant je selectionne une image que je renomme "PHOTO" sur tous les onglets du dossier.

Je souhaite pouvoir supprimer cette image renommée (et uniquement celle-ci, car j'ai des boutons et d'autres photos sur d'autres onglets), si je selectionne une nouvelle position sur mon menu déroulant puis en double cliquant.

J'ai actuellement une formule qui fonctionne lors de la première selection.
lors de la seconde selection, j'ai des superpositions d'images et à la troisième j'ai un message d'erreur.
Voici des extraits de ma macro

Macro de la première page pour inclure l'image (pour les autres pages c'est pareil
Dim a As Integer
Dim Sh1 As Shape

For a = 1 To Worksheets.Count
If Worksheets(a).Name = "1 - Page de garde" Then

For Each Sh1 In Worksheets("1 - Page de garde").Shapes

If Sh1.Name = "PHOTO" Then ActiveSheet.Shapes("PHOTO").Delete

Next Sh1

If Sheets("Information").Range("AAN8").Value = "1" Then
Worksheets("Photos").Visible = True
Sheets("Photos").Select
ActiveSheet.Shapes.Range(Array("Pix_1")).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("1 - Page de garde").Select
Range("$K$5").Select
ActiveSheet.Pictures.Paste.Select
Selection.ShapeRange.Height = 100
Selection.Name = "PHOTO"
Worksheets("Photos").Visible = False

ElseIf Sheets("Information").Range("AAN11").Value = "2" Then
Worksheets("Photos").Visible = True
Sheets("Photos").Select
ActiveSheet.Shapes.Range(Array("Pix_2")).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("1 - Page de garde").Select
Range("$K$5").Select
ActiveSheet.Pictures.Paste.Select
Selection.ShapeRange.Height = 100
Selection.Name = "PHOTO"
Worksheets("Photos").Visible = False
End If

End If
Next a


Merci d'avance
Afficher la suite 

4 réponses

Répondre au sujet
yg_be 4398 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 23 janvier 2018 Dernière intervention - 13 août 2017 à 23:27
+1
Utile
essaie d'éviter ceci
Sheets("Photos").Select
        ActiveSheet.Shapes.Range(Array("Pix_1")).Select
        Selection.Copy

fais plutôt:
Sheets("Photos").Shapes.Range(Array("Pix_1")).Copy

en règle générale, évite les
.select
et les
Active
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de yg_be
yg_be 4398 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 23 janvier 2018 Dernière intervention - 13 août 2017 à 11:19
0
Utile
bonjour, quel message d'erreur, sur quelle ligne?
Commenter la réponse de yg_be
anakin_74 35 Messages postés mercredi 9 octobre 2013Date d'inscription 13 août 2017 Dernière intervention - 13 août 2017 à 21:39
0
Utile
1
Merci tout d'abord d'essayer de m'aider.

Je mets un lien de mon document simplifié.

il suffit de choisir le modèle (de 1 à 12) d'image avec la case F8 puis double click. Faire l'opération 2 autres fois pour avoir le message d'erreur dans le module 01

http://www.cjoint.com/c/GHntzeuELy7

Cordialement
yg_be 4398 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 23 janvier 2018 Dernière intervention - 13 août 2017 à 23:04
le code suivant me semble faux:
For Each Sh4 In Worksheets("4.0 - Welding").Shapes
 
    If Sh4.Name = "PHOTO" Then ActiveSheet.Shapes("PHOTO").Delete

Next Sh4

pourquoi pas:
For Each Sh4 In Worksheets("4.0 - Welding").Shapes
 
    If Sh4.Name = "PHOTO" Then Sh4.Delete

Next Sh4
Commenter la réponse de anakin_74