Copiar solo color de celda en excel a través de VB
Se que se ha tocado en varias ocasiones esta pregunta pero no encuentro lo que busco, necesito copiar solo el color de una celda, dependiendo si el valor de la celda esta en un rango establecido, el que puede variar, el color de esa celda no es fijo, a modo de ejemplo adjunto una tabla. Favor si pueden ayudarme.
1 Respuesta
. 09.02.17 #Formato condicional
Buenas tardes, Waldo
En realidad, lo que solicitas puede realizarse sin necesidad de fórmula alguna, con la función nativa de MS Excel de Formato Condicional.
La ventaja es que ante cambios en las celdas, ellas se pintan automáticamente, sin necesidad de ejecutar macro alguna.
Si estuvieras de acuerdo, sigue los siguientes pasos:
Selecciona la primera celda donde quieres que tome un determinado color, en tu ejemplo: B4. Luego presiona el botón Formato Condicional y elije Nueva Regla.
En la ventana que aparece marca la última opción: Utilice una fórmula que determine...
Luego aparece otra ventana donde le indicarás la condición:
Como notarás, esa fórmula que coloqué en la casilla (en amarillo) evalúa el color a asignar cuando el contenido de la celda supere el "piso" para ese color.
Luego con el botón Formato de ese cuadro, podrás indicarle el color y otros atributos de las celdas del día anterior.
Al dar Aceptar volverás a una pantalla donde podrás agregar las condiciones y colores para los otros casos.
Notarás que se agrega arriba de la regla anterior. Tendras que moverla abajo con los botones que te marco en amarillo. También es importante que marques Detener si es verdad para que no siga evaluando la condición siguiente.
En la imagen ves cómo debería quedarte, allí están las condiciones para cada color.
Al aceptar ESA celda (B4) reaccionará de acuerdo a su contenido.
Finalmente, copia esa celda y sobre el resto de las que deben comportarse así haz Pegado Especial - Formatos.
Espero haber sido suficientemente claro (aunque extenso).
Saludos
Fernando
.
Muchas gracias fejoal por tu respuesta, ya lo había realizado con el formato condicional pero me surgió el problema de los cambio de colores ya que cada vez que se realice el cambio de color de la escala en otra hoja, deberé volver a la base de datos para modificar los colores en el Formato Condicional, por eso pensaba el desarrollo con VB.
O estaré pidiendo mucho?
Pero muy buena tu respuesta y explicación. Saludos
.
Hola, Waldo
Ok, es posible hacerlo a través de VBA.
La siguiente rutina recorre el listado de números que tuvieres y toma el color y los rangos de la tabla que le indiques. Puedes variar los valores, los colores y la cantidad de tramos y el procedimiento seguirá funcionando.
Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:
Option Base 1 Sub ColoreAR() Dim TablaCol() '---- Variables modificables ---- '=== WALDO, modifica estos datos de acuerdo a tu proyecto: HojaOrig = "Hoja2" 'hoja donde está la tabla de colores IniTabla = "D1" 'celda donde inicia la tabla de referencia de colores HojaDest = "Hoja1" 'hoja donde están las celdas a colorear PrimCelda = "B4" ' Celda donde inician las celdas a colorear '---- fin Variables ' '---- inicio de rutina: ' Application.ScreenUpdating = False LaColu = 0 ElTexto = "" 'Loop de coleccion de tabla de colores 'una matriz multidemensional donde el primer elemento es límites inferior del color y 'el segundo es el código de color de la celda inferior ' With Sheets(HojaOrig).Range(IniTabla) Do While Not IsEmpty(.Offset(0, LaColu)) ReDim Preserve TablaCol(2, 1 + LaColu) ElLimite = .Offset(0, LaColu) ElColor = .Offset(1, LaColu).Interior.ColorIndex TablaCol(1, 1 + LaColu) = ElLimite TablaCol(2, 1 + LaColu) = ElColor LaColu = LaColu + 1 Loop End With 'Asignación de color a cada celda ' With Sheets(HojaDest) UltCelda = .Range(Left(PrimCelda, 1) & Rows.Count).End(xlUp).Row Do While .Range(PrimCelda).Offset(LaFila).Row <> UltCelda ElValor = .Range(PrimCelda).Offset(LaFila).Value For Eleme = UBound(TablaCol, 2) To 1 Step -1 If ElValor > TablaCol(1, Eleme) Then .Range(PrimCelda).Offset(LaFila).Interior.ColorIndex = TablaCol(2, Eleme) Cont = Cont + 1 Exit For End If Next LaFila = LaFila + 1 Loop End With ElMensaje = IIf(Cont = 0, "NO SE PINTO CELDA ALGUNA", "Se colorearon: " & Cont + 1 & " celda" & IIf(Cont > 1, "s", "") & Chr(10) & "en la hoja " & HojaDest) TipoMens = IIf(Cont = 0, vbCritical, vbInformation) ElTitulo = IIf(Cont = 0, "NO SE HIZO NADA", "TERMINADO!") Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo End Sub
Nota que, al principio del código, hay unas variables para que lo adaptes a tu archivo, en caso de que las direcciones no coincidan con el ejemplo que pasaste.
Espero que esto sea lo que esperabas.
Un abrazo
Fer
.
