Excel VBA images suppression

Résolu/Fermé

Evedll Messages postés 74 Date d'inscription vendredi 6 juillet 2007 Statut Membre Dernière intervention 26 septembre 2023 - 17 juin 2012 à 18:40
eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 - 22 juin 2012 à 00:07

Bonjour tout le monde,

Voilà ma question :
J'ai un fichier Excel 2007 dans lequel je dois supprimer des images en fonction de certaines cellules vides. En puisant dans les explications de tout le monde, j'ai trouvé comment faire pour une seule image.
Je dois le faire autant de fois que nécessaire selon certaines cellules vides. Donc je dois faire une boucle (oups jamais fait).
En attendant de trouver mieux, j'ai cette solution mais je voudrais pouvoir l'améliorer si possible car cette action est très répétitive. Voici ce que j'ai :

Sub Suppression_Image()

If Range("D104") = "" Then
ActiveSheet.Shapes("IMG_3_G1").Delete

ElseIf Range("D111") = "" Then
ActiveSheet.Shapes("IMG_3_G2").Delete

ElseIf Range("D118") = "" Then
ActiveSheet.Shapes("IMG_3_G3").Delete
End If

...

End Sub

Chaque image doit être supprimée en fonction de la cellule vide correspondant.
Je ne sais pas comment définir qu'une image correspond à une cellule en particulier.
ex : D104 ==> IMG_3_G1
D 111 ==> IMG_3_G2
D118 ==> IMG_3_G3

Remarque : Les adresses sautent de 7 cellules et les noms des images se suivent (je ne sais pas si ça peut aider...).

Je bidouille encore mais j'avance à petit pas.
Si quelqu'un peut m'explique comment procéder, je vous remercie d'avance.
A bientôt
Evelyne

A voir également:

Excel VBA images suppression
Liste déroulante excel - Guide
Forcer suppression fichier - Guide
Formule excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide

8 réponses

Réponse 1 / 8

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
Modifié par eriiic le 17/06/2012 à 21:39

Bonjour,

est-ce que tes images ont toujours la même position relative par rapport à ta cellule ?
Par exemple IMG_3_G1 dans D104 ou 3 cellules à droite de D104...
(tenir compte de l'angle supérieur gauche)
Et si tu pouvais mettre un fichier avec 3 images.

eric

Réponse 2 / 8

Evedll Messages postés 74 Date d'inscription vendredi 6 juillet 2007 Statut Membre Dernière intervention 26 septembre 2023
17 juin 2012 à 23:00

Bonsoir Eric,
Merci de ta réponse.
Oui tout à fait, par exemple, pour l'adresse D104 l'image est dans la fusion de cellules (B101:B105) donc je pense en B101; pour l'adresse D111 l'image est dans la fusion de cellules (B108:B112); pour l'adresse D118 l'image est dans la fusion de cellules (B115:B119). Je suis désolée de ne pas pouvoir mettre mon fichier car comme c'est pour le boulot, je préfère qu'il ne soit pas public (il y a le logo).
Par contre si tu trouves une solution pour que je puisses te l'envoyer directement, pas de soucis. J'ai essayé de mettre une impression écran mais on ne peut pas mettre d'image.

Ca commence à l'adresse D6 jusqu'à D146.
Même chose pour la colonne H, H6 jusqu'à H146 (peut-être plus je ne sais pas encore) avec les images en colonne F. Toujours positionnées de la même façon par rapport à la cellule à contrôler.
C'est une sorte de tickets à remettre.

J'espère que tu comprends ma demande. Dans la négative, précise moi comment je peux te l'envoyer hors forum.

Je te remercie de bien vouloir m'aider.
Bonne soirée
Evelyne

Réponse 3 / 8

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
Modifié par eriiic le 17/06/2012 à 23:50

Re,

C'est toujours mieux avec un fichier, d'autant plus avec des objets...
Il suffit de supprimer ou remplacer ce qui est personnel.

Teste avec ça pour voir :

Sub suppShapes()   
    Dim shap As Shape, lig As Long, col As Long   
    For Each shap In Sheets("Feuil1").Shapes   
        lig = shap.TopLeftCell.Row   
        col = shap.BottomRightCell.Column   
        If lig >= 3 And lig <= 146 And (col = 2 Or col = 6) Then   
            If Cells(lig + 3, col + 2) = "" Then shap.Delete   
        End If   
    Next shap   
End Sub

Sinon dépose un fichier allégé que tu peux me passer en mp.
https://www.cjoint.com/?BFrxLH4UHKS

eric

PS: j'avais oublié la colonne, remplace le code du fichier par celui collé ici.
Si tu as 2 shapes superposés en B3 (par exemples), les 2 seront effacés.

Réponse 4 / 8

Evedll Messages postés 74 Date d'inscription vendredi 6 juillet 2007 Statut Membre Dernière intervention 26 septembre 2023
18 juin 2012 à 00:01

RE,
Comment te mettre le fichier en message privé, je ne l'ai jamais fait
Merci

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 8

Evedll Messages postés 74 Date d'inscription vendredi 6 juillet 2007 Statut Membre Dernière intervention 26 septembre 2023
18 juin 2012 à 00:14

Re,
ça y est je te l'ai envoyé en message privé.
Encore merci

Bonne nuit,

Réponse 6 / 8

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
18 juin 2012 à 08:43

Bonjour,

Lorsque tu vides D6 toutes les autres dates se retrouvent en erreur.
Si tu veux supprimer également les images dont les cellules liées sont en erreur ;

Sub suppShapes()
    Dim shap As Shape, lig As Long, col As Long
    For Each shap In ActiveSheet.Shapes
        If shap.Type = msoPicture Then
            lig = shap.TopLeftCell.Row
            col = shap.BottomRightCell.Column
            If lig >= 3 And lig <= 146 And (col = 2 Or col = 6) Then
                If IsError(Cells(lig + 3, col + 2)) Then
                    shap.Delete
                ElseIf Cells(lig + 3, col + 2) = "" Then
                    shap.Delete
                End If
            End If
        End If
    Next shap
End Sub

J'ai également ajouté le test du type d'objet car tu en as d'autres types sur la feuille.

eric

Réponse 7 / 8

Evedll Messages postés 74 Date d'inscription vendredi 6 juillet 2007 Statut Membre Dernière intervention 26 septembre 2023
19 juin 2012 à 13:11

Bonjour Eric,
Merci de ta réponse. J'ai une semaine chargée, dès que je trouve un moment, j'essaie d'analyser pour comprendre ce que tu as fait et je le teste (je suis pressée de comprendre). Dès que possible, je t'en fais part.

Encore merci
Evelyne

Réponse 8 / 8

Evedll Messages postés 74 Date d'inscription vendredi 6 juillet 2007 Statut Membre Dernière intervention 26 septembre 2023
21 juin 2012 à 22:57

Bonsoir,
Merci beaucoup car ça marche. J'ai un peu compris les lignes pour la première macro mais en ce qui concerne la deuxième, ce que tu as ajouté pour que ça fonctionne je ne l'ai pas tout à fait compris ( If shap.Type = msoPicture Then).

J'arrive parfois à adapter des macros que j'ai effectuées avec l'enregistreur mais la tienne, je n'aurais jamais trouvée.

J'ai trouvé une solution pour les remettre ensuite.
J'ai modifié ta macro pour qu'il supprime le reste, ensuite dans la colonne S j'ai placé des images de la même façon qu'en colonne B et j'ai créé une macro avec l'enregistreur pour les coller dans les colonnes B et F. De cette façon, je les récupère pour une prochaine utilisation.
Je me doute que ce n'est pas la meilleure façon mais j'ai essayé à maintes reprises et n'ai pas trouvé d'autre solution. Du moment que ça marche, c'est super.

Encore merci pour ton aide (il m'arrive dès que je peux de regarder tes macros car je comprends mieux quand il y a un exemple entier pour l'analyser. C'est ma façon pour progresser). Je n'ai pas la prétention de dire que je sais écrire des lignes mais avec l'enregistreur et l'aide de tous, je m'en sort un peu)
A bientôt
Evelyne

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
Modifié par eriiic le 22/06/2012 à 00:11

Bonsoir,

If shap.Type = msoPicture Then
Les autres objets n'ont pas forcément les même propriétés (TopLeftCell,...) et ça plante dans ce cas.

J'ai trouvé une solution pour les remettre ensuite.
Tu ne voulais pas les supprimer ?
Sinon on peut les réduire à 1pixel et les rétablir après, ou changer l'image si elle est dans un répertoire précis...

mais avec l'enregistreur et l'aide de tous, je m'en sort un peu
Je n'ai pas commencé autrement et tu vois qu'on progresse ;-)

eric

Newsletters