Olá, Patropi. Eu já conheço a formatação condicional com ícones, eu quero é pra trazer qualquer imagem. haha Obrigado.

Uma vez fiz algo parecido em topico....

O rapaz precisava q quando aumentasse o valor na celula a barra subia ( na propria celula )...se diminuia a barra descia e se nao alterasse a barra ficava igual....
assim como segue a imagem...

Bom....na epoca eu peguei um criador de fontes TTF pela net e desenhei essas fontes / _ - nos lugares das 4 primeiras letras....

Talvez funcione se vc encontrar algum criador de fontes q deixe inserir imagem....

Acho q achei algo na net pra vc tentar converter os JPG em TTF
http://www.ehow.com/how_7268239_convert ... -font.html

tbem vi q os programas abaixo parecem q fazem isso tbem
Extreme Image Converter
Ivan Image Converter

Obrigado, Leonardo. Vou tentar seguindo essas suas dicas. Tópico segue aberto.

Boa noite!!

Olá,Sparcools, eu sei que você não quer por VBA, mas para o pessoal que gosta de pesquisar, tenho algo....

Sub Imagem_AleVBA()
Application.ScreenUpdating = False
Dim myCell As Range, myShape As Shape
Dim MyImage As String
Dim AddImage As String
Dim Pws As Worksheet, Sws As Worksheet
Set Pws = Sheets("Plan1")
Set Sws = Sheets("Shp")
    For Each cell In Range("E1:E" & Range("E65536").End(xlUp).Row)
        Set myCell = Range("D" & cell.Row)
        For Each myShape In ActiveSheet.Shapes
            If Intersect(myShape.TopLeftCell, myCell) Is Nothing Then
            
            Else
                MyImage = Cells(cell.Row, 5).Text
                Select Case MyImage
                    Case 1
                        If myShape.Name <> "Imagem 5" Then
                            myShape.Delete
                            On Error Resume Next
                            Sws.Activate
                            Sws.Shapes("Imagem 5").Copy
                            Pws.Activate
                            Pws.Range("D" & cell.Row).Activate
                            ActiveSheet.Paste
                           
                        End If
                    Case 2
                        
                        If myShape.Name <> "Imagem 6" Then
                            myShape.Delete
                            On Error Resume Next
                            Sws.Activate
                            Sws.Shapes("Imagem 6").Copy
                            Pws.Activate
                            Pws.Range("D" & cell.Row).Activate
                            ActiveSheet.Paste
                        End If
                    Case 3
                       
                        If myShape.Name <> "Imagem 7" Then '
                            myShape.Delete
                            On Error Resume Next
                            Sws.Activate
                            Sws.Shapes("Imagem 7").Copy
                            Pws.Activate
                            Pws.Range("D" & cell.Row).Activate
                            ActiveSheet.Paste
                        End If
                End Select
               
                Exit For
            End If
        Next myShape
        If myShape Is Nothing Then
            AddImage = Cells(cell.Row, 5).Text
            Select Case AddImage
                Case 1
                    On Error Resume Next
                    Sws.Activate
                    Sws.Shapes("Imagem 5").Copy
                    Pws.Activate
                    Pws.Range("D" & cell.Row).Activate
                    ActiveSheet.Paste
                
                Case 2
                    On Error Resume Next
                    Sws.Activate
                    Sws.Shapes("Imagem 6").Copy
                    Pws.Activate
                    Pws.Range("D" & cell.Row).Activate
                    ActiveSheet.Paste
                
                Case 3
                    On Error Resume Next
                    Sws.Activate
                    Sws.Shapes("Imagem 7").Copy
                    Pws.Activate
                    Pws.Range("D" & cell.Row).Activate
                    ActiveSheet.Paste
                
            End Select
        End If
    Next
    Call LoopShapes
End Sub
Sub LoopShapes()
Application.ScreenUpdating = False
    Dim cb As Shape
    For Each cb In Sheets("Plan1").Shapes
        If cb.Type = 13 Then
            With cb
                .Top = .TopLeftCell.Top + (.TopLeftCell.Height - .Height) / 2
                .Left = .TopLeftCell.Left + (.TopLeftCell.Width - .Width) / 2
            End With
             cb.Select
        End If
    Next
    Application.ScreenUpdating = True
End Sub