Microsoft 365 Effacer des images dans une zone déterminée en VBA

Dvd1976

XLDnaute Nouveau
Salut à tous,

je reviens vers vous car je sèche un peu sur une macro.
Je joins un fichier sommaire pour faire simple.

J'ai essayé pas mal de macros sans succès.

Le but est de supprimer toutes les photos reprises dans la zone C7:J40 et aucune autre ailleurs
(password : 7601) en cliquant sur la corbeille

Pourriez-vous m'orienter vers une solution ?

Merci d'avance :)
 

Pièces jointes

  • Delete_Picture_Dvd1976.xlsx
    223.8 KB · Affichages: 5
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Sinon pour votre présent problème essayez :
Code:
Sub EffaceImagesDansZone()
    Application.ScreenUpdating = False
    For Each Image In ActiveSheet.Shapes
        If Not Intersect(Image.TopLeftCell, [C7:J40]) Is Nothing Then Image.Delete
    Next Image
End Sub
Reste le souci des images qui ne sont pas entièrement dans la zone et ne doivent pas être supprimées, dans ce cas :
Code:
Sub EffaceImagesDansZone()
    Application.ScreenUpdating = False
    For Each Image In ActiveSheet.Shapes
        If Not Intersect(Image.TopLeftCell, [C7:J40]) Is Nothing And _
           Not Intersect(Image.BottomRightCell, [C7:J40]) Is Nothing Then Image.Delete
    Next Image
End Sub
 

Dvd1976

XLDnaute Nouveau
Sorry mais pour l'autre problème je cherche encore mais je pense partir sur ta solution n°2, je reviendrai confirmer cela d'ici peu de temps ;)

pour ce problème ci, je reçois une erreur de compilation pour "image" avec ta macro

erreur macro 1.jpg
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si vous avez un Option explicit au début alors il faut rajouter Dim image.
Voir PJ, chez moi ça marche très bien.
Pour le post précédent, je trouve que l'Essai3 répond exactement à ce que vous attendiez.
 

Pièces jointes

  • Delete_Picture_Dvd1976 (3).xlsm
    239.6 KB · Affichages: 1

Dvd1976

XLDnaute Nouveau
je reviens avec cette fameuse macro pour supprimer les photos.
Tout allait bien, jusqu'au momemnt où j'ai changé la macro qui insère les photos. L'ancien n'ajoutait que du JPG et j'ai changé la macro afin d'insérer d'autre format. Depuis j'ai des messages d'erreurs.

l'erreur est sur les lignes "if not intersect" .... Je ne vois pas en quoi cela n'est pas fonctionnel....

VB:
Sub EffaceImagesDansZone()
    Dim ws As Worksheet, rng As Range
    Set ws = ActiveSheet 'ou Worksheets("Feuil1") par exemple
        ws.Unprotect Password:="7601"
    Dim Image
    Application.ScreenUpdating = False
    For Each Image In ActiveSheet.Shapes
        If Not Intersect(Image.TopLeftCell, [AK4:BC43]) Is Nothing And _
           Not Intersect(Image.BottomRightCell, [AK4:BC43]) Is Nothing Then Image.Delete
    Next Image
    ws.Protect Password:="7601"
End Sub

je remets le fichier en pièce jointe (pass: 7601)
 

Pièces jointes

  • Constatation écart erreur à corriger.xlsm
    203.6 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir,
Je viens d'essayer avec les formats jpg, bmp, gif, png et je n'ai eu aucun souci. Les images s'effacent correctement.
De toute façon il se fiche de l'extension, pour lui c'est Image xx.
Par contre vérifier bien qu'elles s'appellent ainsi, et non pas Picture xx ou autre chose..

1656619897538.png
 

Dvd1976

XLDnaute Nouveau
je viens de détecter le moment où je reçois le code erreur.

en faite, si tu ouvres le fichier et que tu vas dans la partie bleue, tu peux ajouter et supprimer autant de photos que tu veux et cela fonctionnera.
Par contre si tu as une cellule sélectionné dans la partie verte (et à mon avis ailleurs aussi du moement que ce n'est pas dans la partie bleue) et que tu veux cliquer sur la corbeille, là tu reçois l'erreur dont je parle.

voici comment j'arrive à faire apparaitre l'erreur :

1- je remplis le document puis je vais dans la partie bleue
2- j'ajoute des photos et ensuite je clique sur l'enveloppe : le fichier s'enregistre en PDF, le fichier se verrouille, outlook s'ouvre (mais j'annule l'envoi du mail pour pas envoyer les mails pour rien à mes collègues).
3- je ferme le fichier XLSX en le sauvant.
4- j'ouvre à nouveau mon fichier, les photos sont bien présentes.
5- je clique sur la corbeille en ayant préalablement selectionné une cellule dans la partie verte
6- le message d'erreur s'affiche
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Je ne suis pas arrivé à reproduire le problème en suivant vos instructions. C'est bizarre comme phénomène puisque la macro ne s'interesse qu'à la zone AK4:BC43.
Cependant, au cas où, testez cette macro.
Lorsqu'on demande l'effacement je repositionne la cellule active dans la zone bleue. A voir ...
VB:
Sub EffaceImagesDansZone()
    Dim ws As Worksheet, rng As Range
    Set ws = ActiveSheet 'ou Worksheets("Feuil1") par exemple
        ws.Unprotect Password:="7601"
    Dim Image
    ws.[AL5].Select ' Repositionnement de la cellule active en zone bleue.'
    Application.ScreenUpdating = False
    For Each Image In ActiveSheet.Shapes
        If Not Intersect(Image.TopLeftCell, [AK4:BC43]) Is Nothing And _
           Not Intersect(Image.BottomRightCell, [AK4:BC43]) Is Nothing Then Image.Delete
    Next Image
    ws.Protect Password:="7601"
End Sub
 

Dvd1976

XLDnaute Nouveau
la sélection de la cellule AL5 se fait bien ...mais après une erreur de débogage encore et toujours 😭😭😭

je rejoins le fichier tel que je l'utilise.

PS: je trouve étrange que pour tous mes fichiers avec macro excel me demande de les activer à l'ouverture et pour celui-ci il ne me le demande jamais (je suis actuellement sur un Pro Plus 2016)
 

Pièces jointes

  • Constatation écart erreur à corriger.xlsm
    204.1 KB · Affichages: 5

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Votre fichier semble avoir un problème.
Chez moi il ne connait plus Right, il faut mettre Application.Right, et ne reconnait plus [A1] il faut mettre Range("A1") 😭
Je l'ai enregistré en xlsx pour détruire les macros.
Puis je l'ai reconstruit à partir d'un fichier vierge, en important chaque feuille puis en recopiant les macros.
Par contre la partie verte c'est mis en rose. 😂 Allez savoir pourquoi ?
Testez le pour voir, chez moi il marche correctement ( sous XL2007 )
 

Pièces jointes

  • DVD.xlsm
    200.4 KB · Affichages: 2

Discussions similaires

Statistiques des forums

Discussions
311 735
Messages
2 082 023
Membres
101 873
dernier inscrit
excellllll