Obtener el color de una celda
Con la siguiente macro obtengo el color de la celda sin embargo como hacer para que evalúe las celdas del rango C3:G7 sin tener que presionar enter en la celda para obtener el color.
Function obtenercolor1(celda As Range) As String
Application.ScreenUpdating = 0
Dim sColor As String
sColor = Right("000000" & Hex(celda.Interior.color), 6)
obtenercolor1 = Right(sColor, 2) & Mid(sColor, 3, 2) & Left(sColor, 2)
Application.ScreenUpdating = 1
End Function
2 respuestas
Dante, buenas tardes. Es un rango de celdas. Lo que quisiera es que me coloque en otro sitio el valor numérico del color.
Gracias por ocuparte.
Sigo sin entender.
Puedes explicarlo con imágenes.
Lo que quisiera es que me coloque en otro sitio el valor numérico del color.
Pero si tienes varias celdas y cada celda tiene un color, quieres el valor número de cada color, todo concatenado, o quieres el resultado del valor numérico de cada color en una celda diferente.
Además tu función regresa el color en hexadecimal, pero ahora lo quieres en valor numérico.
Puedes aclarar mis dudas.
Dante, muy buenos días. Ahora estoy lejos de la pc para enviarte lo solicitado. Lo preparo prolijo y lo muestro.
De acuerdo, lo explicas con más calma, para darte una solución completa.
Dante, muy buenas noches, gusto de saludarte otra vez.
El rango a evaluar va desde las celdas C3:H7, lo que quisiera es que la macro de obtenercolor1 corra en forma automatica ni bien surja un cambio de color en el rango antes mencionado, pues como lo tengo ahora tengo que meterme en la celda y darle enter a cada celda del rango K4:K18.
Los cambios de color surgen desde distintos botones. Espero se haya entendido.
Gracias por tanto!
Lo que quisiera es que la macro de obtenercolor1 corra en forma automatica ni bien surja un cambio de color en el rango antes mencionado
No es posible que se ejecute en automático, ya que el cambio de color no dispara un evento. Es por eso que tienes que entrar a la celda y presionar enter.
Una opción que implanté hace tiempo, es poner un reloj en la hoja, y cada segundo ejecutar la macro. Pero esto hace lento tu excel y no lo recomiendo.
Los cambios de color surgen desde distintos botones.
Te recomiendo que a cada botón le agregues una línea para ejecutar la siguiente macro:
Sub Poner_Color()
Dim c As Range, f As Range
Dim rng As Range
Dim sColor As String
'
Set rng = Range("C3:H7")
For Each c In Range("J4:J18")
Set f = rng.Find(c, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
c.Interior.Color = f.Interior.Color
sColor = Right("000000" & Hex(f.Interior.Color), 6)
c.Offset(, 1) = Right(sColor, 2) & Mid(sColor, 3, 2) & Left(sColor, 2)
End If
Next
End SubCada que cambies un color con tu botón se actualizarán todos los colores de las celdas J4 a K18.
Ejemplo en un botón:
Sub Boton1() ' 'tú código ' Call Poner_Color End Sub
Este es mi ejemplo. Debes considerar hacia dónde se pasa con el Enter y en ese orden son los resultados:
Y esta es la función:
Function obtenercolorVs(rgo)
'x Elsamatilde
Application.ScreenUpdating = False
Dim sColor As String, cadena As String
For Each cd In Range(rgo.Address)
sColor = Right("000000" & Hex(cd.Interior.Color), 6)
cadena = cadena & Right(sColor, 2) & Mid(sColor, 3, 2) & Left(sColor, 2) & ", "
Next cd
obtenercolorVs = Left(cadena, Len(cadena) - 2) 'se le quita la última coma + espacio
End FunctionPD) Puedes mirar el video N° 20 de mi canal donde dejo otros ejemplos de Funciones Personales.
Sdos.
Elsa