Supprimer l'image d'une cellule (par macro)

Bonjour le forum! (Et bon week-end)

Alors comme le titre l'indique j'aimerai supprimer l'image d'une cellule par macro.

J'ai essayé avec l'enregistreur de macro en vidant ma cellule et voir ce que cela me donne mais cela me supprime juste le contenu de la cellule et non pas l'image qui est au dessus...

Voici le fichier test:

87test2.xlsm (144.93 Ko)

J'ai unE macro qui me permet de sélectionner ma cellule fusionnée C6 et d'y insérer une image et l'adapter à la taille de ma cellule automatiquement liée au bouton "Insertion image".

Sub insere_image_ratio()
        Range("C6").Select
    Dim ficimg As String, Ad As String
    Ad = Selection.Address
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    Set Image = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
    With Image
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Placement = xlMoveAndSize
    End With
    End Sub

J'aimerai y ajouter une fonction qui vide l'image de ma cellule fusionnée avant d'y insérer une nouvelle (pour m'éviter le microscopique effort de cliquer dessus et d'appuyer sur "Suppr" ). Çà peu paraitre bénin comme manipulation mais quand on a à la faire des 10ènes de fois par jour on apprécierai vite d'avoir un bouton qui nous permette de le faire tout seul.

Voila je pense que j'ai bien expliqué la chose, je continue à chercher de mon côté et merci déjà de vous pencher sur ma demande!

A très vite!

Petit up journalier

bonjour

combien a-t-il de d'objets sur la feuille ??

si il y en a 1 seul une petite fonction :

Sub efface()
    Dim img As Object

    For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
     img.Delete
    Next

End Sub

si plusieurs objets sur la feuille et ne vouloir supprimer qu'un seul, une autre solution consisterais au moment de l'insertion de l'image sur la feuille de lui donner un nom spécifique et par la suite supprimer l'objet dont on connais le nom :

apres le set

image.Name = "photo"

et quand on veut supprimer

activesheet.Shapes("photo").Delete

fred

Bonjour.

Et bien j'ai plusieurs objets, deux boutons et une image par feuille.

Le soucis étant que j'ai plus de 700 feuilles... Donc si il y a moyen de renommer mes 700 et quelques images comme tu l'as dis pour la solution numéro deux je suis preneur car le faire manuellement risque d'être long et éprouvent

Effectivement je veux uniquement supprimer l'image en cellule fusionnée C6 et pas les bouton "Précédent" et "Suivant".

La suppression de l'image serait intégrée dans ma macro d'insertion comme ça elle me vide ma cellule pour pouvoir ajouter une nouvelle image.

En tout cas merci pour ta réponse et j'attends avec impatience une solution pour renommer mes images d'un seul coup (peut être encore via macro? ).

re

cela dépend comment a été fait le fichier a la base.....??????

si tes boutons précédent/suivant ont été renommés ?? ou pas ???? est-ce que tes 700 feuilles on été une copie d'une feuille "source" ????

pour bien faire faudrait un fichier test extrait avec 3/4 feuilles pour voir comment cela a été fait.... donc un autre fichier avec un peut plus de feuille pour vérifier...sur plusieurs onglets

fred


en partant du fichier fournit avec seulement deux onglets on peut supposer qu'il y a eut un copier collé d'un feuille source car les boutons insertion image/suivant et précédent portent le même nom sur les deux onglets....

donc si c'est ça voici un code permettant de renommer toutes tes images avec le nouveau nom "photo" dans toutes tes feuilles

Sub renomme_image()
Dim i As Integer
Dim img As Object
For i = 1 To Sheets.Count
    For Each img In Worksheets(i).Shapes 'ou Worksheets("nom").Shapes
    Select Case img.Name
    Case "BtnFiltre", "Flèche droite 2", "Flèche gauche 3"
    'rien faire
    Case Else
    img.Name = "photo"
    End Select

    Next
Next i
End Sub

a+

fred

Effectivement mes feuilles sont des copie d'une autre (pour éviter d'avoir à refaire mes boutons et la mise en forme à chaque fois) et je modifie juste ce qui m'intéresse dedans.

J'ai utilisé ta macro pour renommer mes images "photo" et apparemment avec succès.

J'ai modifié ensuite ma macro d'insertion pour y ajouter (avant l'insertion) la suppression de l'image "photo" dans ma feuille active et apparemment avec succès

Sub insere_image_ratio()
        ActiveSheet.Shapes("photo").Delete
Range("C6").Select
        Dim img As Shape
    With Worksheets(1)
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, .Range("C6")) Is Nothing Then
         Sh.Delete
       End If
    Next Sh
    End With
    Dim ficimg As String, Ad As String
    Ad = Selection.Address
    ficimg = Application.GetOpenFilename(, , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    Set Image = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
        Image.Name = "photo"
    With Image
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Placement = xlMoveAndSize
    End With
    End Sub

Tout fonctionne apparemment à merveille!

Je te remercie et te tiens au courant si problème(s) il y a!

Bonne journée!

Re

Une erreur de détectée.

Lorsque mes images on été renommée "photo" mes flèches "Précédent" et "Suivant" l'ont été également, du coup quand j'appuie sur mon bouton d'insertion d'image et bien j'ai mes flèches qui disparaissent une à une...

Comment faire pour renommer uniquement mes flèches d'un autre nom maintenant qu'elle portent toute le nom "photo" comme mes images en cellule fusionnée?...

En espérant trouver de l'aide :p

tu as travaillé directement sur ton fichier source ???

toujours faire une copie avant de lancer une macro .... car sur les modifications apportées, on peut pas revenir en arrière...!!!!! d'autant plus que j'ai fait exprès de ne pas faire d'enregistrement automatique pour cela ....

pour revenir au sujet si des boutons précédent / suivant on été renommés c'est que tes boutons s’appelaient pas flèche gauche 3 et Flèche droite 2, et donc cela veut dire que tu n'avais pas utilisé la même feuille source pour la création de toutes tes nouvelles feuilles.... c'est aussi la raison pour laquelle je demandait un fichier test un peu plus conséquent.... pour voir...

Si tu as gardé un fichier de base initial, je peut essayé de trouver une autre solution pour renommer les photos comme il faut sans toucher aux bouton prec/suivant.... si tu n'as pas de sauvegarde initiale je ne vois pas comment faire de manière automatique.... reste la manière Manuelle.....

fred

Tu as tout à fait raison j'aurai du faire un copie.

Par contre je suis tout aussi étonné que toi que mes flèches n'ai pas le même nom sur les autre feuilles et se soient transformées en "photo".

Une solution serait peut être de supprimer les flèches et de les re créer? Est-ce possible sans toucher aux images en cellule fusionnée C6?

essaye cela sur un fichier copier, cela va renommer tous les boutons comme il faut normalement

Fred

Sub renomme_bouton()
Dim i As Integer
Dim img As Object
Dim lig, col As Byte
For i = 1 To Sheets.Count
    For Each img In Worksheets(i).Shapes 'ou Worksheets("nom").Shapes
        If img.TopLeftCell.Row > 27 Then

            If img.TopLeftCell.Column > 10 Then
                img.Name = "Flèche droite 2"
            Else
              img.Name = "Flèche gauche 3"
            End If
        End If
    Next
Next i
End Sub

NOOOOOOOOOOOOOOOOOOOOOOOOOOONNNNNNNNNNNNNNNNNNNNNNNNNNNNN!!!!

Mdr comme tu m'as dis que c'était problématique j'ai commencé la démarche de supprimer toute mes "photo" pour ensuite ré insérer sur toutes mes feuilles mes bouton correctement nommé "BoutonPrécédent" et "BoutonSuivant" pour qu'ils ne soient pas affectés par la macro de suppression/insertion image. Mes images en cellule fusionnées sont donc toutes supprimées mais de toute manière je comptai les changer donc pas grave.

Donc du coup à la place de ce problème j'en ai un autre à te poser :p

J'ai rajouté:

 ActiveSheet.Shapes("jaquette").Delete

(Ah oui mes images sont maintenant nommées "jaquette" et non plus "photo" mais peu importe...)

Très pratique donc quand je veux remplacer mon image mais si jamais il n'y a pas encore d'image en cellule fusionnée cela me lance le débogage (normal... on ne peut supprimer une image qui n'existe pas...). Un petit "If" serait donc certainement nécessaire mais je n'y connais fichtrement rien en code.

Je te redonne le code:

Sub insere_image_ratio()
        ActiveSheet.Shapes("jaquette").Delete
        Range("C6").Select
        Dim img As Shape
    With Worksheets(1)
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, .Range("C6")) Is Nothing Then
         Sh.Delete
       End If
    Next Sh
    End With
    Dim ficimg As String, Ad As String
    Ad = Selection.Address
    ficimg = Application.GetOpenFilename(, , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    Set Image = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
        Image.Name = "jaquette"
    With Image
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Placement = xlMoveAndSize
    End With
    End Sub

Donc si il n'y a pas d'image "jaquette" à supprimer et bien directement passer à l'insertion.

J'espère encore une fois avoir ton aide et encore merci!

code a ajouter , gestion des erreurs, pour faire simple en cas d'erreur on passe a l'instruction suivante sans ouvrir la fenettre de debug...

On Error Resume Next 
ActiveSheet.Shapes("jaquette").Delete
 On Error Goto 0

Fred

Code modifié, apparemment cela fonctionne!

Je n'ai pas relevé d'autre erreur ou conflit, suis en train de remettre mes images en cellule fusionnée et mes flèches ont bien un nom différent. J'espère ne pas tomber sur autre chose de plus embêtant.

En tout cas merci et je te tiens au courant si problème il y a! Bonne soirée.


En fait si je reviens encore!

Je me demandais pourquoi un de mes boutons disparaissait quand j'insérai une image via la macro...

Je te donne le fichier test:

34test.xlsm (210.86 Ko)

Clique sur le bouton "Insertion image" de la feuille ".hack Sign..." et tu verra que le bouton rose de la feuille sommaire disparait...

Pourquoi? Bonne question

J'ai testé plusieurs fois et le problème viens bien de la macro d'insertion image:

Sub insere_image_ratio()
            On Error Resume Next
    ActiveSheet.Shapes("jaquette").Delete
     On Error GoTo 0
        Range("C6").Select
        Dim img As Shape
    With Worksheets(1)
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, .Range("C6")) Is Nothing Then
         Sh.Delete
       End If
    Next Sh
    End With
    Dim ficimg As String, Ad As String
    Ad = Selection.Address
    ficimg = Application.GetOpenFilename(, , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    Set Image = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
        Image.Name = "jaquette"
    With Image
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Placement = xlMoveAndSize
    End With
    End Sub

Encore une fois merci de m'apporter ton aide :p

Un petit up!

bonjour

si je peux me permettre ce code ne ressemble a rien ....

déclaration de variables en plein milieu de code...

toutes les variables ne sont pas déclarée, et cela est vrai dans les autres fonctions aussi

il y a un sh et img pour le même shape... en fonction de la partie du code..... cela ressemble a du copier coller de bout de codes différents

de plus tu ecris

With Worksheets(1)

cela veux dire que tu travail sur la feuille 1 de ton fichier.... et non pas sur la feuille active sur laquelle tu veux travailler....

une bonne habitude est de mettre

option explicit 

en debut de module cela oblige a déclarer toutes les variables comme il faut .....

donc pour finir voici ton code modifié qui doit fonctionner...

fred

Option Explicit
Sub insere_image_ratio()
Dim ficimg As String, Ad As String
Dim img As Shape

On Error Resume Next
ActiveSheet.Shapes("jaquette").Delete
On Error GoTo 0
Range("C6").Select
With ActiveSheet
    For Each img In .Shapes
        If Not Application.Intersect(img.TopLeftCell, .Range("C6")) Is Nothing Then
        img.Delete
        End If
    Next img
End With
    Ad = Selection.Address
    ficimg = Application.GetOpenFilename(, , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    Set img = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
    img.Name = "jaquette"
    With img
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Placement = xlMoveAndSize
    End With
End Sub

Re,

Je me débrouille comme je peux avec ce que je trouve! La plus grosse partie du code n'était pas de mon fait mais j'avoue que j'ai rajouté un morceau de formule au début. Jusqu'à maintenant cela fonctionnait sans soucis (sauf pour le bouton) donc aucune raison d'y retoucher et surtout je ne suis pas assez bon pour!

En tout cas j'ai remplacé l'ancien par ce que tu viens de me donner et apparemment cela fonctionne sans me supprimer mon bouton

Merci à toi pour la énième fois et j'espère ne pas revenir (sa serait quand même bête ) .

Bonne soirée!

Rechercher des sujets similaires à "supprimer image macro"