¿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).
2 Respuestas
Armando, ahora lo veo y te contesto por si o por no...
Un beso
Nan
¡Gracias! Nancy Dominguez
Armando, estuve un rato mirando el cuadro estado y todos sus colores, entiendo lo que te dice Abraham, puede ser cierto, pero la verdad no está del todo claro lo que necesitàs, tal vez (me parece tiene que ver con los dìas de vencimiento, o la fecha en que se deben terminar los trabajos, estarìa entendiendo que en funciòn de el tiempo transcurrido, ¿cambia el estado? Help, si me pasas el excel, me haces un favor ME canseee de pintar esos colores feos! Jjajajajajajajajaj
No se cual es tu apuro, pero Dante Amor de este foro, Elsa Matilde Alberto Pedernera, son muyyyyyyyy capaces y suelen responder rápido, solo te recomiendo que pases el excel y seas lo más claro posible, sino... seguís con esta humilde servidora...
Yo no usaria este còdigo Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) porque te enlentece la maquina puesto que cada movimiento ejecuta el codigo, se usa solo para casos muyyy especiales.
Se me ocurre que en función de tus respuesta de como va el tema, me parece si bien son difíciles, lo mejor es hacer matrices,.
Si el excel lo usas a diario, tengo material muy útil, no es fácil encontrarlo, estoy ciega ya :)
¡Gracias! Nancy Dominguez , XD No estoy desesperado por hacerlo rápido (te pido disculpas si eso parece, pero por lo general no descanso ni el fin de semana), solo estoy en compás de espera de si alguien me puede dar una mano. Lo que pasa es que como no me han entendido, estoy tratando de explicarme lo más sencillo posible.
Comparto el archivo para su descarga, el cual se encuentra en este link de DropBox... Si no se puede descargar, por favor avísenme, me han cambiado harto este sistema en la nube, desde la última vez que lo utilicé. Cualquier interrogante, solo me preguntan.
Nancy Dominguez , agradezco tu disposición a ayudarme, no estoy apurado, si eso parece, como ya lo comentaba más arriba, es solo porque trabajo hasta el domingo (no suelo salir mucho ni soy de muchos amigos).
Un beso y un abrazo a la distancia y mucho éxito para este semana que está por comenzar.
@Abraham Valencia, es exactamente eso lo que requiero hacer, pero no sé si será pedirle mucho a Excel.
Veamos:
La idea, de forma sencilla, es que:
Teniendo dos tablas, la primera de ellas expone todos los datos de los trabajos efectuados. La segunda, lista todas las opciones del estado en el que puede encontrarse una tarea ("Pendiente", "En Ejecución", "Atrasado", entre otros). Esta segunda tabla, cada uno de los estados, posee un color de fondo ("Interior.Color") y un color de fuente ("Font.Color") en RGB, ya que de esta forma, me proporciona mayor espectro de colores y personalizados, según requiera el usuario.
Desde la primera tabla, una de las columnas indica el estado de las tareas, corresponde a una lista desplegable, generada por medio de Validación de Datos y la función "Indirecto", llamando desde la segunda tabla las opciones que puedo insertar en este campo.
La idea es que, además de poder utilizar estos datos, es poder utilizar su color de fondo y de fuente, por medio de programación VBA y no por Formato Condicional. La idea es que se pueda reutilizar en otro libro, con otros datos, colores o funciones.
[Hola
Pues teniendo tu archivo no fue nada difícil. Copia y pega esto en el módulo de la hoja "procesos". Ojo, en el módulo de esa hoja y borra todo eso que tienes en el módulo del libro.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CeldaEncontrada As Range
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
Set CeldaEncontrada = Sheets("Config").Range("B3:B13").Find(Target.Value)
If Not CeldaEncontrada Is Nothing Then
CeldaEncontrada.Copy
Target.PasteSpecial Paste:=xlPasteFormats
End If
End If
Set CeldaEncontrada = Nothing
Application.EnableEvents = True
End SubAh, en la hoja "config" nada está con formato "negrita", agrégales para que en la hoja "procesos" también se vea dicho formato al ingresar datos. Comentas.
¡Gracias! Abraham Valencia , es justamente lo que necesitaba. Le hice una pequeña modificación, que tal vez para muchos no tiene importancia, pero de esa forma acoté aún más los parámetros de origen y destino, implementando en el rango los nombres de las tablas, lo que me permitirá hacer posteriores modificaciones del código para implementarlos en otros proyectos.
Te agradezco mucho tu disposición, al igual que a Nancy Dominguez , quien pensó que estaba apurado XP, pero no, solo es que trabajo hasta los domingos, por un tema mental (pasa cuando estás sin trabajo fijo y debes ocupar la mente en algo y mejor si es productivo).
Bueno, a modo de Feedback, les dejo el código modificado, aunque en realidad es menos que mínimo, es válido para futuros lectores de este post:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim CeldaEncontrada As Range
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("tbl_actividades[ESTADO]")) Is Nothing Then
Set CeldaEncontrada = Range("tbl_estados[ESTADOS]").Find(Target.Value)
If Not CeldaEncontrada Is Nothing Then
CeldaEncontrada.Copy
Target.PasteSpecial Paste:=xlPasteFormats
End If
End If
Set CeldaEncontrada = Nothing
Application.EnableEvents = True
End SubNo sé cómo lo hiciste para que te quedara el código VB con los colores del IDE, pero en fin, esa es la única modificación que le realicé a tu código.