Colores por letra en celda

09/12/2005 - 20:03 por Age | Informe spam
Tengo una cedula en donde tengo un listado de empleados, 7 columnas
corresponden a los días de la semana, es decir

Que en la fila 1 columna A tengo el nombre del empleado, en la fila 1
columna b,c,d,e,f,g y h, en sus respectivas celdas puedo poner una serie de
códigos que son letras y quiero que con cada uno de ellos cambien a un color
especifico.

Tengo este macro donde son números para el cambio de color, que cambios
tengo que hacer para que me capte letras.

En el modulo tengo:

Sub ActualizarColores()
Dim rngC As Range
For Each rngC In [Hoja1!A1:C10].Cells
rngC.Value = rngC.Value
Next rngC
Set rngC = Nothing
End Sub

En la hoja tengo:


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.[A1:C10]) Is Nothing Then
With Target.Interior
Select Case Target.Value
Case Is > 6
.ColorIndex = 50
Case Is > 21
.ColorIndex = 51
Case Is = 22
.ColorIndex = 52
Case Is = 23
.ColorIndex = 53
Case Is = 24
.ColorIndex = 54
Case Is = 25
.ColorIndex = 55
Case Is = 26
.ColorIndex = 56
Case Is = 27
.ColorIndex = 57
Case Is = 28
.ColorIndex = 58
Case Is = 29
.ColorIndex = 59

End Select
End With
End If
End Sub


Gracias
 

Leer las respuestas

#1 Age
09/12/2005 - 20:20 | Informe spam
Olvide comentar que con el fomato condcional ya lo intente, pero los codigos
(letras) son 17 y el formato condicional solo permite 6 condciones

"Age" escribió:

Tengo una cedula en donde tengo un listado de empleados, 7 columnas
corresponden a los días de la semana, es decir

Que en la fila 1 columna A tengo el nombre del empleado, en la fila 1
columna b,c,d,e,f,g y h, en sus respectivas celdas puedo poner una serie de
códigos que son letras y quiero que con cada uno de ellos cambien a un color
especifico.

Tengo este macro donde son números para el cambio de color, que cambios
tengo que hacer para que me capte letras.

En el modulo tengo:

Sub ActualizarColores()
Dim rngC As Range
For Each rngC In [Hoja1!A1:C10].Cells
rngC.Value = rngC.Value
Next rngC
Set rngC = Nothing
End Sub

En la hoja tengo:


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.[A1:C10]) Is Nothing Then
With Target.Interior
Select Case Target.Value
Case Is > 6
.ColorIndex = 50
Case Is > 21
.ColorIndex = 51
Case Is = 22
.ColorIndex = 52
Case Is = 23
.ColorIndex = 53
Case Is = 24
.ColorIndex = 54
Case Is = 25
.ColorIndex = 55
Case Is = 26
.ColorIndex = 56
Case Is = 27
.ColorIndex = 57
Case Is = 28
.ColorIndex = 58
Case Is = 29
.ColorIndex = 59

End Select
End With
End If
End Sub


Gracias

Preguntas similares