XL 2016 Code vba pour supprimer des images définies a la fermeture du fichier

[phoceenjo]

Bonjour,

Je souhaiterais de l'aide afin de modifier ce code pour qu'il n'efface pas toutes les photos de la feuille mais uniquement celles de la plage (G1:J12).

Dim img As Object

For Each img In ActiveSheet.Shapes
If img.Type = 13 Then img.Delete
Next

En vous remerciant d'avance,

Je vous souhaite une bonne journée,

Cordialement,

 

[Phil69970]

Bonjour @phoceenjo

Je te propose ce fichier

Sub EffaceMentShapeChamp() 'Code JB
  For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, Range("$G$1:$J$12")) Is Nothing Then  s.Delete
  Next s
End

Et si tu veux que le code s’exécute à la fermeture du fichier tu le mets comme ceci

Sub Workbook_BeforeClose(Cancel As Boolean) 'Code JB
  For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, Range("$G$1:$J$12")) Is Nothing Then  s.Delete
  Next s
End Sub

Merci de ton retour

 

[phoceenjo]

Merci pour votre retour,

J'ai testé les deux et ça ne fonctionne pas. Ce que j'ai oublié de vous préciser c'est que j'ai un code qui me créer un enregistrement en pdf après vérifications du remplissage de toutes les cellules importantes dont certaines avec des images.
Je souhaitais donc incrémenter votre code dans celui existant pour qu'en plus de vider les cellules ayant été remplies de supprimer les images. Voici donc l'ensemble du code :

Sub enregistrer()
Vide = 0 ' Variable vaut 1 si une cellule est vide
Tablo = Array([G5], [F7], [F8], [H9], [H8], [H9], [I8], [I9], [J8], [J9], [G12], [A15], [C19], [C21], [C24], [C27], [F19], [F21], [F24], [F27], [G19], [G21], [G24], [G27], [E32:E43], [E50:E58], [D6371], [A74], [E74], [A84]) ' On définit dans le tableau les cellules qui doivent être non vides
' On vérifie qu'aucune cellule désignée n'est vide
For i = 0 To UBound(Tablo)
For Each cell In Tablo(i)
If cell.Value = "" Then Vide = 1: Exit For
Next cell
' Si Vide =1 donc une cellule vide donc on émet un message et on sort.
If Vide = 1 Then
MsgBox "Veuillez remplir tous les champs." & Chr(10) & "Enregistrement impossible."
Exit Sub
End If
Next i
Chemin = "C:\Users\REDIF\OneDrive - REDIF\REDIF - Documents\Registre d'exploitation\Journalier\" ' Ne pas oublier le "\ à la fin
NomFichier = "Gare 1 - " & Format(Date, "yyyy-mm-dd") & ".pdf"
ChDir Chemin
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

' On vide les cellules, à mon avis inutile car ensuite on quitte le fichier sans enregistrer
For i = 0 To UBound(Tablo)
For Each cell In Tablo(i)
cell.Value = ""
Next cell
Next i

For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("$G$1:$J$12")) Is Nothing Then s.Delete
Next s

' On quitte le fichier sans enregistrer
ActiveWorkbook.Close False
End Sub


Quand j'active le code les images se suppriment mais j'ai un code erreur et la partie ci dessous est surligné en jaune:

If Not Intersect(s.TopLeftCell, Range("$G$1:$J$12")) Is Nothing Then s.Delete




Pouvez vous m'aider s'il vous plait ?

 

[job75]

Bonjour,

Quand j'active le code les images se suppriment mais j'ai un code erreur et la partie ci dessous est surligné en jaune:
If Not Intersect(s.TopLeftCell, Range("$G$1:$J$12")) Is Nothing Then s.Delete

Des Shapes n'ont pas de propriété TopLeftCell : les boutons (Drop Down) des listes de validation.

Et pourquoi supprimer les images puisque ces modifications ne seront pas enregistrées ?

A+

 

[phoceenjo]

Si le fichier est enregistré et j'ai vraiment besoin que les images contenue en (H5:H6); (J5:J6) et (I12:J12) soit effacé a la fermeture du fichier

 

[job75]

Si le fichier est enregistré

Vous savez ce que veut dire ActiveWorkbook.Close False ?

 

[phoceenjo]

Oui, mais la sauvegarde automatique est activé quand même , ActiveWorkbook.Close False ne sert a rien dans le code mais comme il ne le perturbe pas je l'ai laissé

 

[phoceenjo]

J'ai trouvé

Je cherchais a effacer une zone précise d'image car l'image que je souhaitais garder s'effacer aussi.

J'ai changé de méthode en stipulant dans la formule l'image que je souhaitais garder. la voici :

Dim Img As Object
For Each Img In ActiveSheet.Pictures
If Img.Name <> "faron" Then Img.Delete
Next

Merci quand même pour votre aide.

Bonne fin de journée,

Cordialement,