¿Cómo dar color a una celda con el color de otra con VBA?
Tengo un dilema que me surgió hoy, tratando de dar un color a una celda dentro de una tabla (Hoja1), donde mantengo una cantidad de procesos que debo realizar y que tiene cada uno de ellos un estado("tbl_actividades"). En la Hoja2 mantengo otra tabla llamada "tbl_estados" y cada uno de ellos tiene un color, desde donde instancio éstos a la primera tabla en una celda para cada registro, pero con el código que tengo, solo puedo definir el color en el mismo código; para ahorrarme eso, necesito simplificarlo disponiendo del color de cada celda de la tabla "tbl_estados". Les dejo capturas de pantalla:
1. Tabla "tbl_actividades".
2. Tabla "tbl_estados".
Código VBA:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim miRango1 As Range
Dim MiRango2 As Range
Set miRango1 = Range("tbl_actividades[ESTADO]")
For Each CeldaActual In miRango1
If CeldaActual.Value = "ATRASADO" Then
CeldaActual.Interior.Color = RGB(255, 0, 0)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "EN PROCESO" Then
CeldaActual.Interior.Color = RGB(0, 255, 0)
CeldaActual.Font.Color = RGB(0, 0, 0)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "EN PRUEBAS CAJA BLANCA" Then
CeldaActual.Interior.Color = RGB(255, 255, 255)
CeldaActual.Font.Color = RGB(0, 0, 0)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "EN PRUEBAS CAJA NEGRA" Then
CeldaActual.Interior.Color = RGB(0, 0, 0)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "FINALIZADO" Then
CeldaActual.Interior.Color = RGB(1, 101, 0)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "FINALIZADO CON ERRORES" Then
CeldaActual.Interior.Color = RGB(203, 138, 0)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "GENERADO" Then
CeldaActual.Interior.Color = RGB(91, 62, 0)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "LISTO PARA INICIAR" Then
CeldaActual.Interior.Color = RGB(172, 189, 0)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "PENDIENTE CON ERRORES" Then
CeldaActual.Interior.Color = RGB(103, 0, 147)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "PENDIENTE DE INICIAR" Then
CeldaActual.Interior.Color = RGB(147, 0, 69)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "TABULADO PARA INICIAR" Then
CeldaActual.Interior.Color = RGB(0, 1, 147)
CeldaActual.Font.Color = RGB(255, 255, 255)
CeldaActual.Font.Bold = True
ElseIf CeldaActual.Value = "" Then
CeldaActual.Interior.Color = xlNone
CeldaActual.Font.Color = xlNone
End If
Next
End Sub
Desde ya agradezco el apoyo que me puedan brindar para solucionar esta incidencia de capa 8 (entre el teclado y la silla).
Felicitaciones!, te robo macro, yo entendí lo que necesitaba nuestro amigo, pero anoche no logre hacerlo! Saludos! - Nancy Dominguez
Nancy Dominguez , muchas gracias por tu apoyo, dejé el Feedback en los comentarios (le realicé una pequeña modificación al código, para limitar de forma dinámica el rango de ambas hojas) y los agradecimientos a ti y a Abraham Valencia por la ayuda, con todo lo que tengo en la mente, creo que no me hubiese demorado menos de un mes en dar con la solución, está muy compleja mi situación laboral, debiendo esforzarme³. - Armando Vargas Schwarzenberg
Nancy, para mí, y desde hace muchos años, todo lo que escribo públicamente, incluido mi blog, es para que toda persona que quiera lo copie o use. Muchos saludos. - Abraham Valencia
Hola Abraham Valencia , al realizar las pruebas del código, agregando un nuevo registro a la tabla de opciones de estado, me arroja error '1004' en tiempo de ejecución: Error en el método de 'Intersect' de objeto '_Application'. Esto sucede con o sin el cambio mencionado en mi comentario. - Armando Vargas Schwarzenberg