VBA Code to Delete pictures contained in the selected cells

[ellll]

Hi guys,

I'm trying to create a Macro to delete all the pictures contained in the selected (highlighted) cells. The macro has to be used several times and in different Excel files consequently the cell's references change every time.

I created the below macro but it does not work unless I select every image manually:

For Each Pic In Selection
Selection.Delete
Next Pic
End Sub

Please help me!
Thank you

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG19Sep36
[COLOR="Navy"]Dim[/COLOR] Pic [COLOR="Navy"]As[/COLOR] Shape
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Pic [COLOR="Navy"]In[/COLOR] ActiveSheet.Shapes
    [COLOR="Navy"]If[/COLOR] Pic.Type = msoPicture [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Intersect(Pic.TopLeftCell, Selection) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            Pic.Delete
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Pic
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ellll]

Try this:-

[COLOR=Navy]Sub[/COLOR] MG19Sep36
[COLOR=Navy]Dim[/COLOR] Pic [COLOR=Navy]As[/COLOR] Shape
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Pic [COLOR=Navy]In[/COLOR] ActiveSheet.Shapes
    [COLOR=Navy]If[/COLOR] Pic.Type = msoPicture [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] Not Intersect(Pic.TopLeftCell, Selection) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
            Pic.Delete
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
 [COLOR=Navy]Next[/COLOR] Pic
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Thank you Mick!! It works perfectly!! Not to be too cheeky but do you know also if it is possible to add another function to the MACRO above?
I usually have to modify an Excel chart, in the first column of it there are some images, since all the images are the same I would need the MACRO to delete the duplicates (except for the first image) and to unit all the selected cells of the column. The macro above should therefore delete all the pictures contained selected cells except for the first one combining all the selected cells in one cell. Is this possible?
Thank you so so much

 

[MickG]

Are you saying the code should delete all duplicate named images in the selection leaving only the Unique Named images.

 

[ellll]

Yes, the fact is that images do not have a name, their name is "image 1", "image 2",..etc. even if they are the same.

 

[MickG]

How would you then detect that 2 pictures where the same ???

 

[Rick Rothstein]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG19Sep36
[COLOR="Navy"]Dim[/COLOR] Pic [COLOR="Navy"]As[/COLOR] Shape
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Pic [COLOR="Navy"]In[/COLOR] ActiveSheet.Shapes
    [COLOR="Navy"]If[/COLOR] Pic.Type = msoPicture [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Intersect(Pic.TopLeftCell, Selection) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            Pic.Delete
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Pic
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

You do not have to iterate every shape on the worksheet... you can restrict the iterations to just the picture shapes only.

[table="width: 500"]
[tr]
	[td]Sub DeletePicturesWithinSelection()
  Dim Pic As Object
  For Each Pic In ActiveSheet.Pictures
    If Not Intersect(Pic.TopLeftCell, Selection) Is Nothing Then Pic.Delete
  Next Pic
End Sub[/td]
[/tr]
[/table]

 

[MickG]

Rick, I think you will find that returns the Commandbuttons, as well !!

 

[Rick Rothstein]

Rick, I think you will find that returns the Commandbuttons, as well !!

Well there is something I never knew... or expected. Thank you for alerting me to this! And, by the way, it is even worse than you have said... apparently every ActiveX control is included in a worksheet's Picture collection, not just CommandButtons! Now that is really a surprise to me! Thanks for the heads up on this... much appreciated.

 

[ellll]

Visually and by comparing their description (contained in the fourth column). For this reason I think that the MACRO should be set up by deleting all the selected images except for the first one, but I really don't know how to write it down.