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:
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"
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!
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!
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:
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
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!