Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Colores por letra en celda

09/12/2005 - 20:03 por Age | Informe spam
Ayuda Hacer una pregunta
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
email Siga el debateRespuesta 4 respuestasRespuesta Tengo una respuesta

Preguntas similare

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
Respuesta Responder a este mensaje
#2 David
09/12/2005 - 21:17 | Informe spam
No entiendo tu pregunta. ¿En cada celda vas a poner una letra o varias?
¿Quieres que todo el texto se resalte en algún color, o cada letra en color
diferente?

Si vas a poner varias letras, y cada una se resaltará en color diferente,
prueba este código, tal vez te sirva de punto de partida:

Sub ResaltarA()
Dim x As String, j As Integer
x = ActiveCell.Value
For j = 1 To Len(x)
If Mid(x, j, 1) = "A" Then ActiveCell.Characters(Start:=j, _
Length:=1).Font.ColorIndex = 3
Next j
End Sub

Esto te resalta en rojo todas las letras "A" del texto de una celda...

"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
Respuesta Responder a este mensaje
#3 KL
09/12/2005 - 21:35 | Informe spam
Hola Age,

Has probado modificar tu segundo codigo de la siguiente manera?

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 "A"
.ColorIndex = 50
Case "B"
.ColorIndex = 51
Case "C"
.ColorIndex = 52
Case "D"
.ColorIndex = 53
Case "E"
.ColorIndex = 54
Case "F"
.ColorIndex = 55
Case "G"
.ColorIndex = 56
Case "H"
.ColorIndex = 57
Case "I"
.ColorIndex = 58
Case "J"
.ColorIndex = 59
End Select
End With
End If
End Sub

o cambialo por el siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:C10]) Is Nothing Then Exit Sub
n = InStr("ABCDEFGHIJ", UCase(Target))
On Error Resume Next
If n Then Target.Interior.ColorIndex = 49 + n
End Sub

Saludos,
KL
Respuesta Responder a este mensaje
#4 KL
09/12/2005 - 22:21 | Informe spam
si existe la posiblidad de que cambien mas de una celda a la vez (y es que casi siempre existe) y que una celda que tuvo una letra
puede volver a estar vacia prueba este codigo:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:C10]) Is Nothing Then Exit Sub
On Error Resume Next
For Each c In Intersect(Target, [A1:C10])
n = InStr("ABCDEFGHIJ", UCase(c))
If n And c <> "" Then
c.Interior.ColorIndex = 49 + n
Else
c.Interior.ColorIndex = 0
End If
Next c
End Sub


Saludos,
KL


"KL" wrote in message news:uPJdRAQ$
Hola Age,

Has probado modificar tu segundo codigo de la siguiente manera?

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 "A"
.ColorIndex = 50
Case "B"
.ColorIndex = 51
Case "C"
.ColorIndex = 52
Case "D"
.ColorIndex = 53
Case "E"
.ColorIndex = 54
Case "F"
.ColorIndex = 55
Case "G"
.ColorIndex = 56
Case "H"
.ColorIndex = 57
Case "I"
.ColorIndex = 58
Case "J"
.ColorIndex = 59
End Select
End With
End If
End Sub

o cambialo por el siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:C10]) Is Nothing Then Exit Sub
n = InStr("ABCDEFGHIJ", UCase(Target))
On Error Resume Next
If n Then Target.Interior.ColorIndex = 49 + n
End Sub

Saludos,
KL
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida