Anónimo
Dar color a autoformas según los valores en celdas
Tengo un dibujo formado por varias autoformas denominadas FICHA A, FICHA B, FICHA C.. Etc. En la columna A tengo listados los nombres de las autoformas y en la columna B un número del 0 al 11. Quisiera al dar un click en un botón (CommandButton) que las autoformas se colorearan con según el número de la columna B. Son muchas fichas y muchos colores. En principio estaba usando lo siguiente: Private Sub CommandButton1_Click()
Dim FICHA A As Integer, FICHA B As Integer, .....
FICHA A = ActiveSheet.Range("B2").Value
FICHA B = ActiveSheet.Range("B3").Value
....... (resto de autoformas)
If FICHA A = 1 Then
ActiveSheet.Shapes("FICHA A").Select
Selection.ShapeRange.Fill.UserPicture "C:\Indicadores\1.jpg"
ElseIf FICHA A = 2 Then
ActiveSheet.Shapes("FICHA").Select
Selection.ShapeRange.Fill.UserPicture "C:\Indicadores\2.jpg"
ElseIf FICHA A = 3 Then
ActiveSheet.Shapes("FICHA A").Select
Selection.ShapeRange.Fill.UserPicture "C:\Indicadores\3.jpg"...
... Resto de colores y así repetido por cada FICHA.
¿Hay alguna forma de hacerlo más corto?. Me dice que la macro es muy grande. ¿Y hay alguna forma de que el color no lo tenga guardado en mi C sino que pueda cogerlo del propio documento excel? Es para poder enviarlo.
Dim FICHA A As Integer, FICHA B As Integer, .....
FICHA A = ActiveSheet.Range("B2").Value
FICHA B = ActiveSheet.Range("B3").Value
....... (resto de autoformas)
If FICHA A = 1 Then
ActiveSheet.Shapes("FICHA A").Select
Selection.ShapeRange.Fill.UserPicture "C:\Indicadores\1.jpg"
ElseIf FICHA A = 2 Then
ActiveSheet.Shapes("FICHA").Select
Selection.ShapeRange.Fill.UserPicture "C:\Indicadores\2.jpg"
ElseIf FICHA A = 3 Then
ActiveSheet.Shapes("FICHA A").Select
Selection.ShapeRange.Fill.UserPicture "C:\Indicadores\3.jpg"...
... Resto de colores y así repetido por cada FICHA.
¿Hay alguna forma de hacerlo más corto?. Me dice que la macro es muy grande. ¿Y hay alguna forma de que el color no lo tenga guardado en mi C sino que pueda cogerlo del propio documento excel? Es para poder enviarlo.
1 Respuesta
Respuesta de Elsa Matilde
1
En primer lugar te sugiero que no utilices nombres de variables con espacios: FICHA_A en lugar de FICHA A
La rutina que te adjunto y que colocarás en un módulo, recorre la col A.
Toma el objeto cuyo nbre está en col A y le asigna el color que indicas en col B
Por ej:
A B
Nbre1 3
Nbre2 5
Nota: en versión 2007 la lista de colores ha cambiado bastante. Si contás con versión anterior podes encontrar la lista de colores en la Ayuda, bajo el tema: Propiedad Interior colorIndex.
Sub coloreando()
Range("A2").Select
While ActiveCell <> ""
ActiveSheet.Shapes(ActiveCell.Value).Fill.ForeColor.SchemeColor = ActiveCell.Offset(0, 1).Value
La rutina que te adjunto y que colocarás en un módulo, recorre la col A.
Toma el objeto cuyo nbre está en col A y le asigna el color que indicas en col B
Por ej:
A B
Nbre1 3
Nbre2 5
Nota: en versión 2007 la lista de colores ha cambiado bastante. Si contás con versión anterior podes encontrar la lista de colores en la Ayuda, bajo el tema: Propiedad Interior colorIndex.
Sub coloreando()
Range("A2").Select
While ActiveCell <> ""
ActiveSheet.Shapes(ActiveCell.Value).Fill.ForeColor.SchemeColor = ActiveCell.Offset(0, 1).Value
Gracias Elsa. Funciona muy bien. Pero, ¿cómo puedo hacer que se ejecute esa macro al pulsar un botón?
Gracias
Gracias
Depende de qué botón estés por utilizar. Desde menú Ver, Barras de herramientas tenés 2 opciones:
Si lo dibujas con la barra Cuadro de controles, hacé clic derecho sobre el botón, opción Ver código te llevará al Editor, donde encontrarás 2 líneas:
Private Sub CommandButton.........
Call coloreando 'agregar esta línea
End sub
Si lo dibujas con la barra Formulario, clic derecho sobre el botón, opción Asignar macro.
En la ventana que se abre seleccioná esta rutina que ya la tendrás en un módulo y aceptá.
Si todo quedó claro no olvides finalizar la consulta.
Si lo dibujas con la barra Cuadro de controles, hacé clic derecho sobre el botón, opción Ver código te llevará al Editor, donde encontrarás 2 líneas:
Private Sub CommandButton.........
Call coloreando 'agregar esta línea
End sub
Si lo dibujas con la barra Formulario, clic derecho sobre el botón, opción Asignar macro.
En la ventana que se abre seleccioná esta rutina que ya la tendrás en un módulo y aceptá.
Si todo quedó claro no olvides finalizar la consulta.
Perdona que te moleste de nuevo... mi figura se compone de 52 fichas... me da un error al ejecutar "El indice de la colección especificada se encuentra fuera de los límites". ¿Sabes cómo lo puedo solucionar?.
Muchísima gracias
Muchísima gracias
Este mensaje me salió cuando tuve una lista de datos mayor que la cantidad de autoformas dibujadas. Ajustado eso funciona perfecto.
Si necesitas mi modelo podes solicitármelo al correo que encontrarás en mi sitio.
Si necesitas mi modelo podes solicitármelo al correo que encontrarás en mi sitio.
Elsa, ya solucioné el problema.
Ahora intento que los colores que me coja no sean los predeterminados sino unos que yo defino lo he intentado poniendo lo siguiente pero no sale.
Sub Colorear_segun_RAngos()
' Colorear Segun rango de ventas
ActiveWorkbook.Colors(2) = RGB(255, 0, 0)
ActiveWorkbook.Colors(3) = RGB(255, 80, 80)
ActiveWorkbook.Colors(4) = RGB(255, 124, 128)
ActiveWorkbook.Colors(5) = RGB(255, 204, 204)
Range("C2").Select
While ActiveCell <> ""
ActiveSheet.Shapes(ActiveCell.Value).Fill.ForeColor.SchemeColor = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
Wend
End Sub
¿Me sabrías ayudar?.
Es que necesito que sea un color degradado en función del número de ventas. 8> O menor que tal o cual cantidad)
Gracias
Ahora intento que los colores que me coja no sean los predeterminados sino unos que yo defino lo he intentado poniendo lo siguiente pero no sale.
Sub Colorear_segun_RAngos()
' Colorear Segun rango de ventas
ActiveWorkbook.Colors(2) = RGB(255, 0, 0)
ActiveWorkbook.Colors(3) = RGB(255, 80, 80)
ActiveWorkbook.Colors(4) = RGB(255, 124, 128)
ActiveWorkbook.Colors(5) = RGB(255, 204, 204)
Range("C2").Select
While ActiveCell <> ""
ActiveSheet.Shapes(ActiveCell.Value).Fill.ForeColor.SchemeColor = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
Wend
End Sub
¿Me sabrías ayudar?.
Es que necesito que sea un color degradado en función del número de ventas. 8> O menor que tal o cual cantidad)
Gracias
Con las líneas que agregaste, conseguiste cambiar los colores originales por otros, es decir que el color original (que para mi era el 2) ahora quedó como negro, con la línea:
ActiveWorkbook.Colors(2) = RGB(255, 0, 0)
Luego cuando asignas el color 2 (según tu macro la col de autoformas está en la C y la de colores debiera estar entonces en la D) se verá negro, por el cambio que hiciste previamente.
Esto funciona, no comprendo cuál pueda ser tu problema . Si ahora en lugar de recorrer la col de autoformas, necesitas comparar valores, creo que ya estamos hablando de otro tema.
Hasta aquí va según lo solicitado en consulta original.
Sdos!
ActiveWorkbook.Colors(2) = RGB(255, 0, 0)
Luego cuando asignas el color 2 (según tu macro la col de autoformas está en la C y la de colores debiera estar entonces en la D) se verá negro, por el cambio que hiciste previamente.
Esto funciona, no comprendo cuál pueda ser tu problema . Si ahora en lugar de recorrer la col de autoformas, necesitas comparar valores, creo que ya estamos hablando de otro tema.
Hasta aquí va según lo solicitado en consulta original.
Sdos!