Placing an image in a cell

[naveed]

I am working on a project involving images, but I am a little hung up at the very start. My project involves lists of of data, and there are ~12 different types of items, and each item corresponds to a different symbol, so I was planning on having a template sheet which would grab the appropriate item's symbol and place it in the respective cell on the main sheet. However I can't seem to figure out how to place the .bmp images into a cell to easily access it via a macro.

Using the macro recorder it gives me something like this:

ActiveSheet.Shapes("Object 4").Select
    Selection.ShapeRange.IncrementLeft 32.25
    Selection.ShapeRange.IncrementTop 3#
    ActiveSheet.Shapes("Picture 3").Select
    Selection.ShapeRange.IncrementLeft 25.5
    Selection.ShapeRange.IncrementTop -2.25
    ActiveSheet.Shapes("Object 4").Select
    Selection.ShapeRange.IncrementLeft -106.5
    Selection.ShapeRange.IncrementTop 31.5

But I need it to be so that I can select and manipulate the images by selecting cells. I think that gives a decent description of what I'm up against, any ideas?

 

[erik.van.geit]

Hi, naveed
Welcome to the Board !!!!!

would this be a start for you ?

Option Explicit

Sub test()
Dim SH As Shape
Dim thisSH As Shape
Dim PastoHere As Range

Set PastoHere = Range("B2")
Set thisSH = Sheets("shape_sheet").Shapes("shape1")

'remove shape which is currently in the cell
    For Each SH In ActiveSheet.Shapes
        Select Case SH.Type
        Case 4, 8
        Case Else 'some shapes don't have topleftcell (validation, comments)
        If SH.TopLeftCell = PastoHere Then SH.Delete
        End Select
    Next SH

'paste shape
    thisSH.Copy
    PastoHere.Select        'don't know a way without selecting
    ActiveSheet.Paste

'reposition shape
'next part is not needed if the shapes on the shape_sheet are well alligned
    For Each SH In ActiveSheet.Shapes
        Select Case SH.Type
        Case 4, 8
        Case Else
            If SH.TopLeftCell = PastoHere Then
            SH.Top = PastoHere.Top
            SH.Left = PastoHere.Left
            End If
        End Select
    Next SH

End Sub

kind regards,
Erik

 

[naveed]

Thanks for the thorough reply, I will have to play with this and report my results.

Unfortunately I think my peers have decided that using Visio objects instead of .bmp images would be more useful for our application, so more research to be done!