Insert .jpg based on Cell value in Excel?

This basic code will update one cell with a new photo. You will need to change the code to work with each of the cells in question.


Sub AddPictureToCell()
'Standard module code, like: Module1.
Dim ws As Worksheet
Dim myCell As Range
Dim myPhotos As ShapeRange

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet1")
Set myCell = ws.Range("B2")

On Error GoTo myNone
Set myPhotos = myCell.Pictures.ShapeRange
myPhotos.Delete

myNone:
myCell.ColumnWidth = 7
myCell.RowHeight = 30

ws.Pictures.Insert("U:\Excel\Test\aPhoto2.jpg").Select

With Selection
.Top = myCell.Top
.Left = myCell.Left
.Width = myCell.Width
.Height = myCell.Height
.Placement = xlMoveAndSize
.PrintObject = True
End With

myCell.Select
Application.ScreenUpdating = True
End Sub

Joe this is a great start!!

Now I just need to get the picuture to insert based on the value of a cell... any ideas on how to do that?

Just change the Range that it is to work on and change the Picture Drive:/Path/FileName.Ext and you should be good to go!


Sub AddPictureToCell()
'Standard module code, like: Module1.
Dim cell As Object
Dim ws As Worksheet
Dim myRange As Range
Dim myPhotos As ShapeRange

Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
Set myRng = ws.Range("B2:B12")

On Error GoTo noPics
Set myPhotos = ws.Pictures.ShapeRange

If myPhotos.Count > 0 Then myPhotos.Delete

noPics:
For Each cell In myRng
cell.ColumnWidth = 7
cell.RowHeight = 30

If cell.Offset(0, 1).Value > 7 Then ws.Pictures.Insert("U:\Excel\Test\aPhoto2.jpg").Select
If cell.Offset(0, 1).Value < 7 Then ws.Pictures.Insert("U:\Excel\Test\aPhoto.jpg").Select

With Selection
.Top = cell.Top
.Left = cell.Left
.Width = cell.Width
.Height = cell.Height
.Placement = xlMoveAndSize
.PrintObject = True
End With

Next cell
Application.ScreenUpdating = True

ActiveSheet.Range("B1").Select
End Sub

FWIW, if you're not married to the .JPG's you're using, you might be able to avoid macros all together by using =IF(A1<=7,CHAR(152),CHAR(196)), setting the font to "Wingdings 2", and using conditional formatting to change the font color to green/red according to whether A1 is <= or > 7.

That could give you a red octagon or green circle...not 100% what you wanted, but might be close enough.

Actually, using Matt's idea, you can just format the font to wingdings 2 and use a custom format right on the cells with the value (or a simple =A1 type of formula to transfer the value into the cell.) The custom format would be:<ul>[*][Green][<=7]"˜";[Red][>7]"Ä";General[/list]

You could also attach the macro code version to that sheets Change Event and it will be dynamic and automatically change as the values change, rather than you needing to run the macro.

The macro may be more envolved, but it does look better than formatting though!

A working example...

Here is an example of how to update a picture using a workbook name without the need for VBA code. There is an explanation in the attached workbook.

UpdatePicUsingWorkbookName.zip

Even better than the last time Tom showed Joe & me how to do this (no VBA this time). Tom, once again, I doff me cap to ye.

All of these are great!! Thanks guys!