conditionally insert image

Hello,
I'm working on a rating system that will provide feed back based on one of
five images. The range of values is between 0 and 1.

0 - .2
..21 - .4
..41 - .6
..61 - 8
..81 - 1

I would like to be able to select a column of numbers and have a macro that
selects from one of five images to place in that cell.

Thanks to people on this discussion board, I've already got the code that
will insert an image based on an cell value (if A1 = 1, then insert an image)
as well as centering and sizing the image to the cell, but....I haven't yet
figured out (nor seen on the discussion board) how to assign a picture per
cell over a range of cells, based on the values in the cells.

Any help you can provide will be most appreciated.
Many thanks in advance,
MJohn

Obviously it would be to use the same code on the other cells.

> I would like to be able to select a column of numbers and have a macro that
> selects from one of five images to place in that cell.

What does that mean - select a column, but put a value in a cell? - what
cell - a column has 65536 cells. Be specific about what you are doing.

Post your code that you have described and exactly what range of cells you
want to work with and when you want the action to happen and how the action
will happen and perhaps someone can give you some advice.

How would be something like the cell changes based on a formula, the cell
changes because someone edits it, the cell changes because a macro changes
it.

--
Regards,
Tom Ogilvy



"M John" wrote:

> Hello,
> I'm working on a rating system that will provide feed back based on one of
> five images. The range of values is between 0 and 1.
>
> 0 - .2
> .21 - .4
> .41 - .6
> .61 - 8
> .81 - 1
>
> I would like to be able to select a column of numbers and have a macro that
> selects from one of five images to place in that cell.
>
> Thanks to people on this discussion board, I've already got the code that
> will insert an image based on an cell value (if A1 = 1, then insert an image)
> as well as centering and sizing the image to the cell, but....I haven't yet
> figured out (nor seen on the discussion board) how to assign a picture per
> cell over a range of cells, based on the values in the cells.
>
> Any help you can provide will be most appreciated.
> Many thanks in advance,
> MJohn

Okay, sorry for the ambiguity.
Here's the code:

Sub InsertGIF()
Dim myCell As Range
Set myCell = Selection

On Error Resume Next
If ActiveCell.Value <= 0.2 Then
ActiveSheet.Shapes("A1 Picture").Delete
ActiveCell.Select
ActiveSheet.Pictures.Insert("C:\Ratings\05Worst.gif").Select
Selection.Name = "A1 Picture"
With ActiveSheet.Shapes("A1 Picture")
.Top = ActiveCell.Top + (ActiveCell.Height - .Height) / 2
.Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
End With
Else
ActiveSheet.Shapes("A1 Picture").Delete
End If

myCell.Select
End Sub

And to clear up the 'column' matter. For cells with the following values:

A1 = .05
B1 = 0.1
C1 = 0.15
D1 = 0.2
E1 = 0.25
F1 = 0.3
G1 = 0.35

The above code correctly places a "03Worst.gif" image in the first four
cells, if I go through and individually select them.....what I would like, is
to select the whole range of cells and run a macro that will assign other
pictures to the other values, up to 1, based on the range scheme below.

Hope this clears things up. Thanks for the quick response.

MJohn

"Tom Ogilvy" wrote:

> Obviously it would be to use the same code on the other cells.
>
> > I would like to be able to select a column of numbers and have a macro that
> > selects from one of five images to place in that cell.
>
> What does that mean - select a column, but put a value in a cell? - what
> cell - a column has 65536 cells. Be specific about what you are doing.
>
> Post your code that you have described and exactly what range of cells you
> want to work with and when you want the action to happen and how the action
> will happen and perhaps someone can give you some advice.
>
> How would be something like the cell changes based on a formula, the cell
> changes because someone edits it, the cell changes because a macro changes
> it.
>
> --
> Regards,
> Tom Ogilvy
>
>
>
> "M John" wrote:
>
> > Hello,
> > I'm working on a rating system that will provide feed back based on one of
> > five images. The range of values is between 0 and 1.
> >
> > 0 - .2
> > .21 - .4
> > .41 - .6
> > .61 - 8
> > .81 - 1
> >
> > I would like to be able to select a column of numbers and have a macro that
> > selects from one of five images to place in that cell.
> >
> > Thanks to people on this discussion board, I've already got the code that
> > will insert an image based on an cell value (if A1 = 1, then insert an image)
> > as well as centering and sizing the image to the cell, but....I haven't yet
> > figured out (nor seen on the discussion board) how to assign a picture per
> > cell over a range of cells, based on the values in the cells.
> >
> > Any help you can provide will be most appreciated.
> > Many thanks in advance,
> > MJohn

If the selection is anywhere in the Range A1:g1, It processes the entire
range A1:G1

Sub InsertGIF()
Dim myCell As Range, cell As Range
Dim shp As Shape, rng1 As Range
Dim shp1 As Picture
Dim s As String
Set rng1 = Range("A1:G1")
Set myCell = Selection

If Not Intersect(myCell, rng1) Is Nothing Then
For Each cell In Range("A1:G1")
If cell.Value <= 0.2 Then
On Error Resume Next
s = cell.Address(0, 0) & " Picture"
Set shp = ActiveSheet.Shapes(s)
shp.Delete
On Error GoTo 0
'"C:\Ratings\05Worst.gif"
Set shp1 = ActiveSheet.Pictures.Insert("C:\woodland.gif")
shp1.Name = s
With shp1
.Top = cell.Top + (cell.Height - .Height) / 2
.Left = cell.Left + (cell.Width - .Width) / 2
End With
Else
On Error Resume Next
s = cell.Address(0, 0) & " Picture"
Set shp = ActiveSheet.Shapes(s)
shp.Delete
On Error GoTo 0
End If
Next
End If
End Sub

--
Regards,
Tom Ogilvy


"M John" wrote:

> Okay, sorry for the ambiguity.
> Here's the code:
>
> Sub InsertGIF()
> Dim myCell As Range
> Set myCell = Selection
>
> On Error Resume Next
> If ActiveCell.Value <= 0.2 Then
> ActiveSheet.Shapes("A1 Picture").Delete
> ActiveCell.Select
> ActiveSheet.Pictures.Insert("C:\Ratings\05Worst.gif").Select
> Selection.Name = "A1 Picture"
> With ActiveSheet.Shapes("A1 Picture")
> .Top = ActiveCell.Top + (ActiveCell.Height - .Height) / 2
> .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
> End With
> Else
> ActiveSheet.Shapes("A1 Picture").Delete
> End If
>
> myCell.Select
> End Sub
>
> And to clear up the 'column' matter. For cells with the following values:
>
> A1 = .05
> B1 = 0.1
> C1 = 0.15
> D1 = 0.2
> E1 = 0.25
> F1 = 0.3
> G1 = 0.35
>
> The above code correctly places a "03Worst.gif" image in the first four
> cells, if I go through and individually select them.....what I would like, is
> to select the whole range of cells and run a macro that will assign other
> pictures to the other values, up to 1, based on the range scheme below.
>
> Hope this clears things up. Thanks for the quick response.
>
> MJohn
>
> "Tom Ogilvy" wrote:
>
> > Obviously it would be to use the same code on the other cells.
> >
> > > I would like to be able to select a column of numbers and have a macro that
> > > selects from one of five images to place in that cell.
> >
> > What does that mean - select a column, but put a value in a cell? - what
> > cell - a column has 65536 cells. Be specific about what you are doing.
> >
> > Post your code that you have described and exactly what range of cells you
> > want to work with and when you want the action to happen and how the action
> > will happen and perhaps someone can give you some advice.
> >
> > How would be something like the cell changes based on a formula, the cell
> > changes because someone edits it, the cell changes because a macro changes
> > it.
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> > "M John" wrote:
> >
> > > Hello,
> > > I'm working on a rating system that will provide feed back based on one of
> > > five images. The range of values is between 0 and 1.
> > >
> > > 0 - .2
> > > .21 - .4
> > > .41 - .6
> > > .61 - 8
> > > .81 - 1
> > >
> > > I would like to be able to select a column of numbers and have a macro that
> > > selects from one of five images to place in that cell.
> > >
> > > Thanks to people on this discussion board, I've already got the code that
> > > will insert an image based on an cell value (if A1 = 1, then insert an image)
> > > as well as centering and sizing the image to the cell, but....I haven't yet
> > > figured out (nor seen on the discussion board) how to assign a picture per
> > > cell over a range of cells, based on the values in the cells.
> > >
> > > Any help you can provide will be most appreciated.
> > > Many thanks in advance,
> > > MJohn

EXCELLENT. Woo-hoo. That inserted the "05Worst.gif" across rows and
columns. That's beautiful.

If I can get the .21<x<=.4 (and subsequent parts) coded, I'll be set. I'm
guessing this will be something like

Else If cell.Value > 0.2 And <=0.4 Then...

Am I on the right track?

Again, many thanks.

MJohn

"Tom Ogilvy" wrote:

> If the selection is anywhere in the Range A1:g1, It processes the entire
> range A1:G1
>
> Sub InsertGIF()
> Dim myCell As Range, cell As Range
> Dim shp As Shape, rng1 As Range
> Dim shp1 As Picture
> Dim s As String
> Set rng1 = Range("A1:G1")
> Set myCell = Selection
>
> If Not Intersect(myCell, rng1) Is Nothing Then
> For Each cell In Range("A1:G1")
> If cell.Value <= 0.2 Then
> On Error Resume Next
> s = cell.Address(0, 0) & " Picture"
> Set shp = ActiveSheet.Shapes(s)
> shp.Delete
> On Error GoTo 0
> '"C:\Ratings\05Worst.gif"
> Set shp1 = ActiveSheet.Pictures.Insert("C:\woodland.gif")
> shp1.Name = s
> With shp1
> .Top = cell.Top + (cell.Height - .Height) / 2
> .Left = cell.Left + (cell.Width - .Width) / 2
> End With
> Else
> On Error Resume Next
> s = cell.Address(0, 0) & " Picture"
> Set shp = ActiveSheet.Shapes(s)
> shp.Delete
> On Error GoTo 0
> End If
> Next
> End If
> End Sub
>
> --
> Regards,
> Tom Ogilvy
>
>
> "M John" wrote:
>
> > Okay, sorry for the ambiguity.
> > Here's the code:
> >
> > Sub InsertGIF()
> > Dim myCell As Range
> > Set myCell = Selection
> >
> > On Error Resume Next
> > If ActiveCell.Value <= 0.2 Then
> > ActiveSheet.Shapes("A1 Picture").Delete
> > ActiveCell.Select
> > ActiveSheet.Pictures.Insert("C:\Ratings\05Worst.gif").Select
> > Selection.Name = "A1 Picture"
> > With ActiveSheet.Shapes("A1 Picture")
> > .Top = ActiveCell.Top + (ActiveCell.Height - .Height) / 2
> > .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
> > End With
> > Else
> > ActiveSheet.Shapes("A1 Picture").Delete
> > End If
> >
> > myCell.Select
> > End Sub
> >
> > And to clear up the 'column' matter. For cells with the following values:
> >
> > A1 = .05
> > B1 = 0.1
> > C1 = 0.15
> > D1 = 0.2
> > E1 = 0.25
> > F1 = 0.3
> > G1 = 0.35
> >
> > The above code correctly places a "03Worst.gif" image in the first four
> > cells, if I go through and individually select them.....what I would like, is
> > to select the whole range of cells and run a macro that will assign other
> > pictures to the other values, up to 1, based on the range scheme below.
> >
> > Hope this clears things up. Thanks for the quick response.
> >
> > MJohn
> >
> > "Tom Ogilvy" wrote:
> >
> > > Obviously it would be to use the same code on the other cells.
> > >
> > > > I would like to be able to select a column of numbers and have a macro that
> > > > selects from one of five images to place in that cell.
> > >
> > > What does that mean - select a column, but put a value in a cell? - what
> > > cell - a column has 65536 cells. Be specific about what you are doing.
> > >
> > > Post your code that you have described and exactly what range of cells you
> > > want to work with and when you want the action to happen and how the action
> > > will happen and perhaps someone can give you some advice.
> > >
> > > How would be something like the cell changes based on a formula, the cell
> > > changes because someone edits it, the cell changes because a macro changes
> > > it.
> > >
> > > --
> > > Regards,
> > > Tom Ogilvy
> > >
> > >
> > >
> > > "M John" wrote:
> > >
> > > > Hello,
> > > > I'm working on a rating system that will provide feed back based on one of
> > > > five images. The range of values is between 0 and 1.
> > > >
> > > > 0 - .2
> > > > .21 - .4
> > > > .41 - .6
> > > > .61 - 8
> > > > .81 - 1
> > > >
> > > > I would like to be able to select a column of numbers and have a macro that
> > > > selects from one of five images to place in that cell.
> > > >
> > > > Thanks to people on this discussion board, I've already got the code that
> > > > will insert an image based on an cell value (if A1 = 1, then insert an image)
> > > > as well as centering and sizing the image to the cell, but....I haven't yet
> > > > figured out (nor seen on the discussion board) how to assign a picture per
> > > > cell over a range of cells, based on the values in the cells.
> > > >
> > > > Any help you can provide will be most appreciated.
> > > > Many thanks in advance,
> > > > MJohn

Oh, and here's how I modified the code you gave me to make it a more generic
as to the row/columns:

Sub InsertGIF()
Dim myCell As Range, cell As Range
Dim shp As Shape, rng1 As Range
Dim shp1 As Picture
Dim s As String
Set rng1 = Selection
Set myCell = Selection

If Not Intersect(myCell, rng1) Is Nothing Then
For Each cell In rng1
If cell.Value <= 0.2 Then
On Error Resume Next
s = cell.Address(0, 0) & " Picture"
Set shp = ActiveSheet.Shapes(s)
shp.Delete
On Error GoTo 0
Set shp1 = ActiveSheet.Pictures.Insert("C:\Documents and
Settings\michael.j.foley\Desktop\Ratings\05Worst.GIF")
shp1.Name = s
With shp1
.Top = cell.Top + (cell.Height - .Height) / 2
.Left = cell.Left + (cell.Width - .Width) / 2
End With
Else
On Error Resume Next
s = cell.Address(0, 0) & " Picture"
Set shp = ActiveSheet.Shapes(s)
shp.Delete
On Error GoTo 0
End If
Next
End If
End Sub

"Tom Ogilvy" wrote:

> If the selection is anywhere in the Range A1:g1, It processes the entire
> range A1:G1
>
> Sub InsertGIF()
> Dim myCell As Range, cell As Range
> Dim shp As Shape, rng1 As Range
> Dim shp1 As Picture
> Dim s As String
> Set rng1 = Range("A1:G1")
> Set myCell = Selection
>
> If Not Intersect(myCell, rng1) Is Nothing Then
> For Each cell In Range("A1:G1")
> If cell.Value <= 0.2 Then
> On Error Resume Next
> s = cell.Address(0, 0) & " Picture"
> Set shp = ActiveSheet.Shapes(s)
> shp.Delete
> On Error GoTo 0
> '"C:\Ratings\05Worst.gif"
> Set shp1 = ActiveSheet.Pictures.Insert("C:\woodland.gif")
> shp1.Name = s
> With shp1
> .Top = cell.Top + (cell.Height - .Height) / 2
> .Left = cell.Left + (cell.Width - .Width) / 2
> End With
> Else
> On Error Resume Next
> s = cell.Address(0, 0) & " Picture"
> Set shp = ActiveSheet.Shapes(s)
> shp.Delete
> On Error GoTo 0
> End If
> Next
> End If
> End Sub
>
> --
> Regards,
> Tom Ogilvy
>
>
> "M John" wrote:
>
> > Okay, sorry for the ambiguity.
> > Here's the code:
> >
> > Sub InsertGIF()
> > Dim myCell As Range
> > Set myCell = Selection
> >
> > On Error Resume Next
> > If ActiveCell.Value <= 0.2 Then
> > ActiveSheet.Shapes("A1 Picture").Delete
> > ActiveCell.Select
> > ActiveSheet.Pictures.Insert("C:\Ratings\05Worst.gif").Select
> > Selection.Name = "A1 Picture"
> > With ActiveSheet.Shapes("A1 Picture")
> > .Top = ActiveCell.Top + (ActiveCell.Height - .Height) / 2
> > .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
> > End With
> > Else
> > ActiveSheet.Shapes("A1 Picture").Delete
> > End If
> >
> > myCell.Select
> > End Sub
> >
> > And to clear up the 'column' matter. For cells with the following values:
> >
> > A1 = .05
> > B1 = 0.1
> > C1 = 0.15
> > D1 = 0.2
> > E1 = 0.25
> > F1 = 0.3
> > G1 = 0.35
> >
> > The above code correctly places a "03Worst.gif" image in the first four
> > cells, if I go through and individually select them.....what I would like, is
> > to select the whole range of cells and run a macro that will assign other
> > pictures to the other values, up to 1, based on the range scheme below.
> >
> > Hope this clears things up. Thanks for the quick response.
> >
> > MJohn
> >
> > "Tom Ogilvy" wrote:
> >
> > > Obviously it would be to use the same code on the other cells.
> > >
> > > > I would like to be able to select a column of numbers and have a macro that
> > > > selects from one of five images to place in that cell.
> > >
> > > What does that mean - select a column, but put a value in a cell? - what
> > > cell - a column has 65536 cells. Be specific about what you are doing.
> > >
> > > Post your code that you have described and exactly what range of cells you
> > > want to work with and when you want the action to happen and how the action
> > > will happen and perhaps someone can give you some advice.
> > >
> > > How would be something like the cell changes based on a formula, the cell
> > > changes because someone edits it, the cell changes because a macro changes
> > > it.
> > >
> > > --
> > > Regards,
> > > Tom Ogilvy
> > >
> > >
> > >
> > > "M John" wrote:
> > >
> > > > Hello,
> > > > I'm working on a rating system that will provide feed back based on one of
> > > > five images. The range of values is between 0 and 1.
> > > >
> > > > 0 - .2
> > > > .21 - .4
> > > > .41 - .6
> > > > .61 - 8
> > > > .81 - 1
> > > >
> > > > I would like to be able to select a column of numbers and have a macro that
> > > > selects from one of five images to place in that cell.
> > > >
> > > > Thanks to people on this discussion board, I've already got the code that
> > > > will insert an image based on an cell value (if A1 = 1, then insert an image)
> > > > as well as centering and sizing the image to the cell, but....I haven't yet
> > > > figured out (nor seen on the discussion board) how to assign a picture per
> > > > cell over a range of cells, based on the values in the cells.
> > > >
> > > > Any help you can provide will be most appreciated.
> > > > Many thanks in advance,
> > > > MJohn

I would do it like this if you have 5 different pictures you want to
display:

Sub InsertGIF()
Dim myCell As Range, cell As Range
Dim shp As Shape, rng1 As Range
Dim shp1 As Picture
Dim s As String, sPath = String
Dim s2 as String
Set rng1 = Selection
Set myCell = Selection

sPath = "C:\Documents and Settings\" & _
"michael.j.foley\Desktop\Ratings\"
If Not Intersect(myCell, rng1) Is Nothing Then
For Each cell In rng1
If cell.Value >= 0 and cellValue <= 1.0 then
If cell.Value <= 0.2 Then
s2 = "05Worst.GIF"
elseif cell.Value <= 0.4 then
s2 = "04Worst.Gif"
elseif cell.Value <= 0.6 then
s2 = "03Worst.Gif"
elseif cell.Value <= 0.8 then
s2 = "02Worst.Gif"
elseif cell.Value <= 1.0 then
s2 = "01Worst.Gif"
end if

On Error Resume Next
s = cell.Address(0, 0) & " Picture"
Set shp = ActiveSheet.Shapes(s)
shp.Delete
On Error GoTo 0
Set shp1 = ActiveSheet.Pictures.Insert(sPath & s2)
shp1.Name = s
With shp1
.Top = cell.Top + (cell.Height - .Height) / 2
.Left = cell.Left + (cell.Width - .Width) / 2
End With
Else
On Error Resume Next
s = cell.Address(0, 0) & " Picture"
Set shp = ActiveSheet.Shapes(s)
shp.Delete
On Error GoTo 0
End If
Next
End If
End Sub


--
Regards,
Tom Ogilvy

"M John" <[email protected]> wrote in message
news:[email protected]...
> EXCELLENT. Woo-hoo. That inserted the "05Worst.gif" across rows and
> columns. That's beautiful.
>
> If I can get the .21<x<=.4 (and subsequent parts) coded, I'll be set. I'm
> guessing this will be something like
>
> Else If cell.Value > 0.2 And <=0.4 Then...
>
> Am I on the right track?
>
> Again, many thanks.
>
> MJohn
>
> "Tom Ogilvy" wrote:
>
> > If the selection is anywhere in the Range A1:g1, It processes the entire
> > range A1:G1
> >
> > Sub InsertGIF()
> > Dim myCell As Range, cell As Range
> > Dim shp As Shape, rng1 As Range
> > Dim shp1 As Picture
> > Dim s As String
> > Set rng1 = Range("A1:G1")
> > Set myCell = Selection
> >
> > If Not Intersect(myCell, rng1) Is Nothing Then
> > For Each cell In Range("A1:G1")
> > If cell.Value <= 0.2 Then
> > On Error Resume Next
> > s = cell.Address(0, 0) & " Picture"
> > Set shp = ActiveSheet.Shapes(s)
> > shp.Delete
> > On Error GoTo 0
> > '"C:\Ratings\05Worst.gif"
> > Set shp1 = ActiveSheet.Pictures.Insert("C:\woodland.gif")
> > shp1.Name = s
> > With shp1
> > .Top = cell.Top + (cell.Height - .Height) / 2
> > .Left = cell.Left + (cell.Width - .Width) / 2
> > End With
> > Else
> > On Error Resume Next
> > s = cell.Address(0, 0) & " Picture"
> > Set shp = ActiveSheet.Shapes(s)
> > shp.Delete
> > On Error GoTo 0
> > End If
> > Next
> > End If
> > End Sub
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> > "M John" wrote:
> >
> > > Okay, sorry for the ambiguity.
> > > Here's the code:
> > >
> > > Sub InsertGIF()
> > > Dim myCell As Range
> > > Set myCell = Selection
> > >
> > > On Error Resume Next
> > > If ActiveCell.Value <= 0.2 Then
> > > ActiveSheet.Shapes("A1 Picture").Delete
> > > ActiveCell.Select
> > > ActiveSheet.Pictures.Insert("C:\Ratings\05Worst.gif").Select
> > > Selection.Name = "A1 Picture"
> > > With ActiveSheet.Shapes("A1 Picture")
> > > .Top = ActiveCell.Top + (ActiveCell.Height - .Height) / 2
> > > .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
> > > End With
> > > Else
> > > ActiveSheet.Shapes("A1 Picture").Delete
> > > End If
> > >
> > > myCell.Select
> > > End Sub
> > >
> > > And to clear up the 'column' matter. For cells with the following
values:
> > >
> > > A1 = .05
> > > B1 = 0.1
> > > C1 = 0.15
> > > D1 = 0.2
> > > E1 = 0.25
> > > F1 = 0.3
> > > G1 = 0.35
> > >
> > > The above code correctly places a "03Worst.gif" image in the first
four
> > > cells, if I go through and individually select them.....what I would
like, is
> > > to select the whole range of cells and run a macro that will assign
other
> > > pictures to the other values, up to 1, based on the range scheme
below.
> > >
> > > Hope this clears things up. Thanks for the quick response.
> > >
> > > MJohn
> > >
> > > "Tom Ogilvy" wrote:
> > >
> > > > Obviously it would be to use the same code on the other cells.
> > > >
> > > > > I would like to be able to select a column of numbers and have a
macro that
> > > > > selects from one of five images to place in that cell.
> > > >
> > > > What does that mean - select a column, but put a value in a cell? -
what
> > > > cell - a column has 65536 cells. Be specific about what you are
doing.
> > > >
> > > > Post your code that you have described and exactly what range of
cells you
> > > > want to work with and when you want the action to happen and how the
action
> > > > will happen and perhaps someone can give you some advice.
> > > >
> > > > How would be something like the cell changes based on a formula, the
cell
> > > > changes because someone edits it, the cell changes because a macro
changes
> > > > it.
> > > >
> > > > --
> > > > Regards,
> > > > Tom Ogilvy
> > > >
> > > >
> > > >
> > > > "M John" wrote:
> > > >
> > > > > Hello,
> > > > > I'm working on a rating system that will provide feed back based
on one of
> > > > > five images. The range of values is between 0 and 1.
> > > > >
> > > > > 0 - .2
> > > > > .21 - .4
> > > > > .41 - .6
> > > > > .61 - 8
> > > > > .81 - 1
> > > > >
> > > > > I would like to be able to select a column of numbers and have a
macro that
> > > > > selects from one of five images to place in that cell.
> > > > >
> > > > > Thanks to people on this discussion board, I've already got the
code that
> > > > > will insert an image based on an cell value (if A1 = 1, then
insert an image)
> > > > > as well as centering and sizing the image to the cell, but....I
haven't yet
> > > > > figured out (nor seen on the discussion board) how to assign a
picture per
> > > > > cell over a range of cells, based on the values in the cells.
> > > > >
> > > > > Any help you can provide will be most appreciated.
> > > > > Many thanks in advance,
> > > > > MJohn

Mr. Ogilvy,
Wow. That works (with only one modification: deleted the "shp.Delete" so
that the entire selected field gets rated) EXACTLY as I hoped it would.

Thank you very much. You're an all star.

MJohn

"Tom Ogilvy" wrote:

> I would do it like this if you have 5 different pictures you want to
> display:
>
> Sub InsertGIF()
> Dim myCell As Range, cell As Range
> Dim shp As Shape, rng1 As Range
> Dim shp1 As Picture
> Dim s As String, sPath = String
> Dim s2 as String
> Set rng1 = Selection
> Set myCell = Selection
>
> sPath = "C:\Documents and Settings\" & _
> "michael.j.foley\Desktop\Ratings\"
> If Not Intersect(myCell, rng1) Is Nothing Then
> For Each cell In rng1
> If cell.Value >= 0 and cellValue <= 1.0 then
> If cell.Value <= 0.2 Then
> s2 = "05Worst.GIF"
> elseif cell.Value <= 0.4 then
> s2 = "04Worst.Gif"
> elseif cell.Value <= 0.6 then
> s2 = "03Worst.Gif"
> elseif cell.Value <= 0.8 then
> s2 = "02Worst.Gif"
> elseif cell.Value <= 1.0 then
> s2 = "01Worst.Gif"
> end if
>
> On Error Resume Next
> s = cell.Address(0, 0) & " Picture"
> Set shp = ActiveSheet.Shapes(s)
> shp.Delete
> On Error GoTo 0
> Set shp1 = ActiveSheet.Pictures.Insert(sPath & s2)
> shp1.Name = s
> With shp1
> .Top = cell.Top + (cell.Height - .Height) / 2
> .Left = cell.Left + (cell.Width - .Width) / 2
> End With
> Else
> On Error Resume Next
> s = cell.Address(0, 0) & " Picture"
> Set shp = ActiveSheet.Shapes(s)
> shp.Delete
> On Error GoTo 0
> End If
> Next
> End If
> End Sub
>
>
> --
> Regards,
> Tom Ogilvy
>
> "M John" <[email protected]> wrote in message
> news:[email protected]...
> > EXCELLENT. Woo-hoo. That inserted the "05Worst.gif" across rows and
> > columns. That's beautiful.
> >
> > If I can get the .21<x<=.4 (and subsequent parts) coded, I'll be set. I'm
> > guessing this will be something like
> >
> > Else If cell.Value > 0.2 And <=0.4 Then...
> >
> > Am I on the right track?
> >
> > Again, many thanks.
> >
> > MJohn
> >
> > "Tom Ogilvy" wrote:
> >
> > > If the selection is anywhere in the Range A1:g1, It processes the entire
> > > range A1:G1
> > >
> > > Sub InsertGIF()
> > > Dim myCell As Range, cell As Range
> > > Dim shp As Shape, rng1 As Range
> > > Dim shp1 As Picture
> > > Dim s As String
> > > Set rng1 = Range("A1:G1")
> > > Set myCell = Selection
> > >
> > > If Not Intersect(myCell, rng1) Is Nothing Then
> > > For Each cell In Range("A1:G1")
> > > If cell.Value <= 0.2 Then
> > > On Error Resume Next
> > > s = cell.Address(0, 0) & " Picture"
> > > Set shp = ActiveSheet.Shapes(s)
> > > shp.Delete
> > > On Error GoTo 0
> > > '"C:\Ratings\05Worst.gif"
> > > Set shp1 = ActiveSheet.Pictures.Insert("C:\woodland.gif")
> > > shp1.Name = s
> > > With shp1
> > > .Top = cell.Top + (cell.Height - .Height) / 2
> > > .Left = cell.Left + (cell.Width - .Width) / 2
> > > End With
> > > Else
> > > On Error Resume Next
> > > s = cell.Address(0, 0) & " Picture"
> > > Set shp = ActiveSheet.Shapes(s)
> > > shp.Delete
> > > On Error GoTo 0
> > > End If
> > > Next
> > > End If
> > > End Sub
> > >
> > > --
> > > Regards,
> > > Tom Ogilvy
> > >
> > >
> > > "M John" wrote:
> > >
> > > > Okay, sorry for the ambiguity.
> > > > Here's the code:
> > > >
> > > > Sub InsertGIF()
> > > > Dim myCell As Range
> > > > Set myCell = Selection
> > > >
> > > > On Error Resume Next
> > > > If ActiveCell.Value <= 0.2 Then
> > > > ActiveSheet.Shapes("A1 Picture").Delete
> > > > ActiveCell.Select
> > > > ActiveSheet.Pictures.Insert("C:\Ratings\05Worst.gif").Select
> > > > Selection.Name = "A1 Picture"
> > > > With ActiveSheet.Shapes("A1 Picture")
> > > > .Top = ActiveCell.Top + (ActiveCell.Height - .Height) / 2
> > > > .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
> > > > End With
> > > > Else
> > > > ActiveSheet.Shapes("A1 Picture").Delete
> > > > End If
> > > >
> > > > myCell.Select
> > > > End Sub
> > > >
> > > > And to clear up the 'column' matter. For cells with the following
> values:
> > > >
> > > > A1 = .05
> > > > B1 = 0.1
> > > > C1 = 0.15
> > > > D1 = 0.2
> > > > E1 = 0.25
> > > > F1 = 0.3
> > > > G1 = 0.35
> > > >
> > > > The above code correctly places a "03Worst.gif" image in the first
> four
> > > > cells, if I go through and individually select them.....what I would
> like, is
> > > > to select the whole range of cells and run a macro that will assign
> other
> > > > pictures to the other values, up to 1, based on the range scheme
> below.
> > > >
> > > > Hope this clears things up. Thanks for the quick response.
> > > >
> > > > MJohn
> > > >
> > > > "Tom Ogilvy" wrote:
> > > >
> > > > > Obviously it would be to use the same code on the other cells.
> > > > >
> > > > > > I would like to be able to select a column of numbers and have a
> macro that
> > > > > > selects from one of five images to place in that cell.
> > > > >
> > > > > What does that mean - select a column, but put a value in a cell? -
> what
> > > > > cell - a column has 65536 cells. Be specific about what you are
> doing.
> > > > >
> > > > > Post your code that you have described and exactly what range of
> cells you
> > > > > want to work with and when you want the action to happen and how the
> action
> > > > > will happen and perhaps someone can give you some advice.
> > > > >
> > > > > How would be something like the cell changes based on a formula, the
> cell
> > > > > changes because someone edits it, the cell changes because a macro
> changes
> > > > > it.
> > > > >
> > > > > --
> > > > > Regards,
> > > > > Tom Ogilvy
> > > > >
> > > > >
> > > > >
> > > > > "M John" wrote:
> > > > >
> > > > > > Hello,
> > > > > > I'm working on a rating system that will provide feed back based
> on one of
> > > > > > five images. The range of values is between 0 and 1.
> > > > > >
> > > > > > 0 - .2
> > > > > > .21 - .4
> > > > > > .41 - .6
> > > > > > .61 - 8
> > > > > > .81 - 1
> > > > > >
> > > > > > I would like to be able to select a column of numbers and have a
> macro that
> > > > > > selects from one of five images to place in that cell.
> > > > > >
> > > > > > Thanks to people on this discussion board, I've already got the
> code that
> > > > > > will insert an image based on an cell value (if A1 = 1, then
> insert an image)
> > > > > > as well as centering and sizing the image to the cell, but....I
> haven't yet
> > > > > > figured out (nor seen on the discussion board) how to assign a
> picture per
> > > > > > cell over a range of cells, based on the values in the cells.
> > > > > >
> > > > > > Any help you can provide will be most appreciated.
> > > > > > Many thanks in advance,
> > > > > > MJohn
>
>
>