PDA

View Full Version : Solved: Copy images with VBA



gdl
04-28-2009, 03:27 AM
Hello!

I'm a newbie of VBA for Excel and I have a problem with image management.

Working with excel 2003, my problem is this:
- I have a workbook made of several worksheet with the same 10 rows of heading
- I've put an image (as logo) in a determinated cell of the first worksheet
- I want to write a macro that copies it in the same position in all other worksheets.

My main problem is that I can't manage to get the image from the cell address that contains it. In simpler word, the end user will put the wanted image in cell B1 and I need a macro that picks image in cell B1 up and copies it (I can do this last part only). The problem is that image name may vary.

How can this be done? I've searched a lot on the web and on the help of vba but didn't find any answer :banghead:

I also tried to do if differently: ask the user to select the image and then copy it. But I can't do this either :dunno Is it possible to ask for some action and then wait for the user to accomplish that?

Those who help will have my eternal gratitude :hi:

Thanks

Giorgio

Bob Phillips
04-28-2009, 03:49 AM
Here is a simple function that should get you the name of the image over a nominated cell



Function GetShapeOverCell(cell As Range) As String
Dim shp As Shape

For Each shp In ActiveSheet.Shapes

If shp.Left < cell.Offset(0, 1).Left And _
shp.Top < cell.Offset(1, 0).Top And _
(shp.Width - shp.Left + 1) >= cell.Left And _
(shp.Height - shp.Top + 1) >= cell.Top Then

GetShapeOverCell = shp.Name
End If
Next shp

End Function

Bob Phillips
04-28-2009, 03:52 AM
Correction



Function GetShapeOverCell(cell As Range) As String
Dim shp As Shape

For Each shp In ActiveSheet.Shapes

If shp.Left < cell.Offset(0, 1).Left And _
shp.Top < cell.Offset(1, 0).Top And _
(shp.Width + shp.Left - 1) >= cell.Left And _
(shp.Height + shp.Top - 1) >= cell.Top Then

GetShapeOverCell = shp.Name
Exit Function
End If
Next shp

End Function

gdl
04-28-2009, 07:54 AM
Thanks a lot xld, now I understand how to do everything!

Have a nice day