Excel VBA images suppression Résolu/Fermé

Question

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


Configuration: Windows 7 / Internet Explorer 9.0

eriiic · Answer

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

Evedll · Answer

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

eriiic · Answer

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.

Evedll · Answer

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

Evedll · Answer

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

eriiic · Answer

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

Evedll · Answer

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

Evedll · Answer

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