Anónimo
Diferente color fuente y celda según valor
Tengo una hoja de Excel y quiero que se ponga del mismo color tanto la fuente como el fondo de algunas celdas, dependiendo del valor que introduzca en ellas, y que dicho color se elimine al borrar el valor de la celda. Esto debe ocurrir solo en las celdas de ciertos rangos especificados, no en toda la hoja. A continuación copio dos modelos de códigos que he puesto en práctica. El problema es que si borro los datos de celdas contiguas, es decir, de un rango, me sale el siguiente mensaje de error: Se ha producido el error "13" en tiempo de ejecución: No coinciden los tipos. Si marco "Depurar", en la ventana del error, se marca en amarillo la línea: Case Is = "A" en el editor de Microsoft de Visual Basic. ¿Cómo lo puedo solucionar? Espero haber sido lo suficientemente explicito. (Aclaro que los códigos siguientes son copiados buscando en Internet y reformados como he podido). Muchas Gracias
Modelo a):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Selection.Interior.ColorIndex = None
Dim icolor As Integer
If Not Intersect(Target, Range("B3:D20,F3:G20,B27:E34")) Is Nothing Then
Select Case Target
Case Is = "A"
icolor = 8
Target.Font.ColorIndex = 8
Case Is = "B"
icolor = 7
Target.Font.ColorIndex = 7
Case Is = "C"
icolor = 12
Target.Font.ColorIndex = 12
Case Is = "D"
icolor = 11
Target.Font.ColorIndex = 11
Case Is = "E"
icolor = 10
Target.Font.ColorIndex = 10
Case Else
'Cualquier cosa
End Select
Target.Interior.ColorIndex = icolor
End If
End Sub
Modelo b):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Selection.Interior.ColorIndex = None
Dim ColorIndex As Integer
If Not Intersect(Target, Range("B3:D20,F3:G20,B27:E34")) Is Nothing Then
Select Case Target
Case Is = "A"
Target.Interior.ColorIndex = 8
Target.Font.ColorIndex = 8
Case Is = "B"
Target.Interior.ColorIndex = 7
Target.Font.ColorIndex = 7
Case Is = "C"
Target.Interior.ColorIndex = 12
Target.Font.ColorIndex = 12
Case Else
'Cualquier cosa
End Select
Salida:
End If
End Sub
Modelo a):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Selection.Interior.ColorIndex = None
Dim icolor As Integer
If Not Intersect(Target, Range("B3:D20,F3:G20,B27:E34")) Is Nothing Then
Select Case Target
Case Is = "A"
icolor = 8
Target.Font.ColorIndex = 8
Case Is = "B"
icolor = 7
Target.Font.ColorIndex = 7
Case Is = "C"
icolor = 12
Target.Font.ColorIndex = 12
Case Is = "D"
icolor = 11
Target.Font.ColorIndex = 11
Case Is = "E"
icolor = 10
Target.Font.ColorIndex = 10
Case Else
'Cualquier cosa
End Select
Target.Interior.ColorIndex = icolor
End If
End Sub
Modelo b):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Selection.Interior.ColorIndex = None
Dim ColorIndex As Integer
If Not Intersect(Target, Range("B3:D20,F3:G20,B27:E34")) Is Nothing Then
Select Case Target
Case Is = "A"
Target.Interior.ColorIndex = 8
Target.Font.ColorIndex = 8
Case Is = "B"
Target.Interior.ColorIndex = 7
Target.Font.ColorIndex = 7
Case Is = "C"
Target.Interior.ColorIndex = 12
Target.Font.ColorIndex = 12
Case Else
'Cualquier cosa
End Select
Salida:
End If
End Sub
1 Respuesta
Respuesta de Elsa Matilde
1
Las 2 rutinas tienen como primera instrucción la que evalúa si se han seleccionado varias celdas, y si así fuera las deja sin color.
Allí ya debiera salirse del proceso a mi entender. Pruébalo reemplazando esa línea por estas otras y luego me comentas si con esto alcanza.
Private Sub ...... '
If Target.Count > 1 Then
Selection.Interior.ColorIndex = None
Exit Sub
End If
Dim icolor As Integer ' a partir de aquí continua tu rutina
Saludos
Elsa
* Aún sin un manual VBA ?
http://es.geocities.com/lacibelesdepunilla/manuales
Allí ya debiera salirse del proceso a mi entender. Pruébalo reemplazando esa línea por estas otras y luego me comentas si con esto alcanza.
Private Sub ...... '
If Target.Count > 1 Then
Selection.Interior.ColorIndex = None
Exit Sub
End If
Dim icolor As Integer ' a partir de aquí continua tu rutina
Saludos
Elsa
* Aún sin un manual VBA ?
http://es.geocities.com/lacibelesdepunilla/manuales
Muchas gracias Elsa por tu respuesta. El problema de borrar celdas contiguas se ha solucionado estupendamente, ya no me sale el mensaje de error. Lo que ocurre es que al introducir valores (en este caso letras) que no son los que deben cumplir las condiciones especificadas en la rutina, algunas veces, no todas, toman el color de alguna de dichas condiciones, y lo toman solo la fuente, no el fondo de celda; y esos valores deberían quedar de color negro (automático).
Muchas gracias por anticipado. Un saludo
Muchas gracias por anticipado. Un saludo
La primera, tiene un error, porque luego del End Select (es decir, luego de comparar el valor) le sigue 1 instrucción que asigna color y va para todos los casos.
Usá la 2da rutina que asigna los colores en cada case.
Incluso yo agregaría que lo deje sin color (o automático) por si anteriormente tenia algún formato.
Así en la 2da rutina, reemplazá donde dice 'cualquier cosa' por estas líneas:
Target.interior.colorindex = xlnone
target.font.colorindex = 0
Usá la 2da rutina que asigna los colores en cada case.
Incluso yo agregaría que lo deje sin color (o automático) por si anteriormente tenia algún formato.
Así en la 2da rutina, reemplazá donde dice 'cualquier cosa' por estas líneas:
Target.interior.colorindex = xlnone
target.font.colorindex = 0
Muchísimas gracias Elsa. Funciona a la perfección. Yo había intentado poner al final solo: target.font. Colorindex = 0. Pero el modo que me has descrito es más correcto para la fuente y el fondo de celda. Gracias de nuevo. Saludos.