Conditional Picture?

  • Thread starter Thread starter AlexCdeC
  • Start date Start date
A

AlexCdeC

Does anybody knows how to insert one picture that changes without use
intervention everytime the result of another cell changes?
eg.: If the cell A1="Alex" the cell A2=Picture of Alex. Then if
change the cell A1 to "Mike" the cell A2 displays the picture of Mike
 
Hi Alex

This macro example from this group a long time ago you can use.
The jpg files must have the same names as the number you type in cell "a1"
Change the path to the files in the code.

Place the code in the Sheet module

Right click on a sheet tab and choose view code
Paste the code there
Alt-Q to go back to Excel


Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim rngProducts As Range
Dim pic As Picture, shp As Shape
Dim szInvalids As String

On Error Resume Next
'Only insert the picture if it's in the area where they type the Product Names
'Change "a1" to a range of cells where they'll be typing in Product numbers
Set rngProducts = Intersect(Me.Range("a1"), Target)
On Error GoTo 0

If Not rngProducts Is Nothing Then 'They entered a product number
'Loop through each cell they entered in
' in case they copied several product numbers into several cells
For Each rng In rngProducts
'Remove the exisitng picture (shape) from the cell to the right
For Each shp In Me.Shapes
If shp.TopLeftCell.Address = rng.Offset(0, 1).Address _
Then shp.Delete
Next shp
'Insert the picture
On Error Resume Next
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Ron\MyFiles\" _
& rng.Text & ".jpg")
On Error GoTo 0
If Not pic Is Nothing Then 'The picture exists
With pic
.Height = rng.Offset(0, 1).Height
.Width = rng.Offset(0, 1).Width
.Left = rng.Offset(0, 1).Left
.Top = rng.Offset(0, 1).Top
End With
Else 'Invalid entry, add it to the list of invalids
szInvalids = szInvalids & rng.Address & ": " & rng.Text & vbLf
End If
Next rng

'Show them the invalid entries if there wer any
If Len(szInvalids) Then
szInvalids = "The following were either invalid product entries or " & vbLf _
& "the product's image could not be found:" & vbLf & vbLf & szInvalids
MsgBox szInvalids, vbExclamation
End If
End If
End Sub
 
One way:

Add all the pictures you want to the worksheet. Name them Pict_Alex, Pict_Mike,
Pict_namehere.

Put them all where you want them to show up (probably directly on top of each
other????).

Then right click on the worksheet tab that holds the pictures and select view
code. Paste this in:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPict As Picture

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub

For Each myPict In Me.Pictures
myPict.Visible = CBool(StrComp(myPict.Name, _
"pict_" & Target.Value, vbTextCompare) = 0)
Next myPict

End Sub

When you type in the name in A1, this worksheet event will fire and the code
will hide all the pictures whose name doesn't match pict_valueinA1.

A tip for renaming the pictures. Select each and type the new name in the
namebox--to the left of the formula bar. Remember to hit enter when you're done
typing.
 
Back
Top