Bom dia!!
Na Guia "Control" Coluna E, o restante fica por conta da rotina
Sub CheckColor(myCell As Range, myNameToShape As String, myValueToColor As String)
Dim myShape As Shape
Dim myTargetCell As Range
Dim myColorCode As Long
On Error GoTo Catch
Set myTargetCell = Range(myNameToShape).Columns(1).Find(myCell.Name.Name, LookAt:=xlWhole)
Set myShape = Sheets(1).Shapes(myTargetCell.Offset(0, 1))
GoTo Finally
Catch:
Exit Sub
Finally:
On Error GoTo 0
If myCell.Value < Range(myValueToColor).Cells(2, 1).Value Then
myColorCode = Range(myValueToColor).Cells(1, 2).Value
Else
myColorCode = Application.WorksheetFunction.VLookup(myCell.Value, Range(myValueToColor), 2, True)
End If
myShape.Fill.ForeColor.RGB = myColorCode
End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 20/06/2013 9:43 am