jueves, 1 de julio de 2010

VBA: Formato de gráfico condicionado por sus valores.

Realizó un usuario una consulta curiosa, y tras algunas investigaciones por la red encontré una respuesta adecuada.
El lector quería realizar un gráfico de barras, condicionando el color de las barras al valor asociado, mediante un código de VBA:

...referente a la posibilidad de realizar un gráfico condicional utilizando VBA.
Necesito los gáficos de barras en los que las barras sean de un color si su valor es mayor a un valor (2,4) y de otro color si su valor es menor a 2,4...





Partiremos de una Tabla de datos, y un gráfico ya construido; se trata entonces de que cada vez que cambiemos los valores en nuestra tabla de datos, el color de las barras cambie de un color (rojo) a otro (azul) según sea mayor o menor a 2,4.
El gráfico se ha llamado '1 Gráfico', además incorporaremos la programación adecuada para que el gráfico se actualice cada vez que la Tabla de datos se modifica, mediante la instrucción worksheet_change(ByVal target As Range) incluida en la 'Hoja1' desde la que trabajaremos (es muy importante editar nuestro código dentro de la 'Hoja1', no dentro de un Módulo del Editor de VBA !!!).
Nuestro código será entonces:


'ejecuta macro al modificar alguna celda en la Hoja1
Sub worksheet_change(ByVal target As Range)
'definimos las variables que emplearemos en el desarrollo de la macro
Dim Pto As Long
Dim Val As Variant
Dim nombrehoja, rangocelda As String
'asignamos a las variables nombrehoja y rangocelda un valor
nombrehoja = ActiveSheet.Name
rangocelda = ActiveCell.Address
'el siguiente código controla el valor de cada barra de nuestro gráfico
'y le asigna un color (rojo o azul)

ActiveSheet.ChartObjects("1 Gráfico").Activate
With ActiveChart.SeriesCollection(1)
Val = .Values
For Pto = 1 To UBound(Val)
If Val(Pto) <= 2.4 Then
.Points(Pto).Interior.Color = RGB(255, 0, 0)
Else: .Points(Pto).Interior.Color = RGB(0, 0, 255)
End If
Next Pto
End With

'termina la macro devolviéndonos a una celda activa de la Hoja de cálculo activa
Sheets(nombrehoja).Range(rangocelda).Select
End Sub



... y listo, cada vez que cambiemos un valor en la Hoja, y en concreto dentro de la Tabla de datos, se asignará el color rojo o azul si es mayor o menor que 2.4.

72 comentarios:

  1. Eres un fenomeno!!!!!!!!!!!!!
    No esperaba tan pronto la solucion
    La probaré y os comento a todos
    Gracias por el aporte
    "El Novato"

    ResponderEliminar
    Respuestas
    1. Hola yo necesito ayuda con algo parecido. Quien me puede ayudar? por favorrrr

      Eliminar
    2. Hola,
      si planteas tu pregunta, y cuánto de parecido es a lo explicado, quizá pueda darte una respuesta.
      Slds

      Eliminar
  2. Una muy buena solución para esta cuestión
    Gracias por el aporte
    funciona a las milmaravillas

    ResponderEliminar
  3. Una excelente solución doctor

    ResponderEliminar
  4. El trabajo y por tanto la enhorabuena es para ExcelForo que como dije antes ¡Es un fenomeno!
    Te garantizo funciona a la perfección.
    Busqué opciones por la web y encontré alguna pero ninguna como esta.

    ResponderEliminar
  5. En realidad es una gran ayuda Excelforo muchas muchas gracias,

    ResponderEliminar
  6. Hola, Hola quisiera saber si me puedes ayudar a crear una macro que me ayude a realizar bases de datos como para poder buscar Nombres dentro de ella.. si Por favor Gracias

    ResponderEliminar
  7. Janina,
    Lamento responderte tan tarde... pero me ha sido imposible por motivos personales hacerlo hasta hoy.
    Realmente no necesitas una macro para esto, existe una herramienta estandar en Excel, llamada formulario (ver ejemplo), que te permitirá no solo crear tu base de datos, si no también a realizar búsquedas o filtros sobre los diferentes campos que tenga tu base de datos.
    Un saludo y disculpa de nuevo mi tardanza.

    ResponderEliminar
  8. Me dice que no encuentra "ChartObjects" :S ¿Qué puede ser eso?

    ResponderEliminar
  9. Hola Exar-Kun,
    debes asegurarte que el gráfico que exista en tu hoja de cálculo se llame igual que en código VBA, en mi caso '1 Gráfico'.
    Slds

    ResponderEliminar
  10. Gonzalo Herreraagosto 08, 2012

    Gracis por el aporte, funciona perfecto aunque en mi caso mi gráfica tiene 3 series y no se como indicar que las barras que cambiarán de color son las de la tercera serie pues siempre colorea las de la primera.

    ResponderEliminar
  11. Gonzalo Herreraagosto 08, 2012

    Gracias de nuevo. Ya solucioné mi problema.

    ResponderEliminar
    Respuestas
    1. Hola
      Al igual que Gonzalo, tengo varias series y no se cómo indicarlas, me ayudarías? Parece que ya le respondiste pero no encuentro el comentario con la respuesta. Muchas gracias!

      Att: Laura Barajas

      Eliminar
    2. Hola Laura,
      la clave es variar en esta intrucción
      ActiveChart.SeriesCollection(1)
      el 1 por cada una de las tres series.
      Podrías incluir un FOR..NEXT por encima del de los Points para que recorra cada Serie y cada punto de la serie.
      For serie=1 to 3
      With ActiveChart.SeriesCollection(serie)
      Val = .Values
      For Pto = 1 To UBound(Val)
      If Val(Pto) <= 2.4 Then
      .Points(Pto).Interior.Color = RGB(255, 0, 0)
      Else: .Points(Pto).Interior.Color = RGB(0, 0, 255)
      End If
      Next Pto
      End With
      Next serie

      Te debería funcionar.
      Slds

      Eliminar
    3. Mil gracias!! Funcionó perfecto y se simplifica más el código porque son varias series.
      Saludos,
      Laura

      Eliminar
  12. Hola, me resultò muy ùtil tu aporte para una gràfica que debo hacer, pero querìa saber como cambiar el còdigo para ponre màs colores,
    digamos:
    entre 0 y 1 azul
    entre 1.1 y 2 naranja
    y asì

    y si se puede que los datos a checar en el VBA sean otros y no los que se usan en la gràfica

    ResponderEliminar
    Respuestas
    1. Hola David,
      si, claro, es posible definir más posibilidades para los rangos de cantidades.
      Tendrías que añadir más condiciones IF para cubrir todas las opciones, algo del estilo
      IF Val(Pto) > 0 AND Val(Pto) <=1 then .Points(Pto).Interior.Color = RGB(255, 0, 0)
      else if Val(Pto) >1 AND Val(Pto)<=2 then .Points(Pto).Interior.Color = RGB(0, 255, 0)
      Else: .Points(Pto).Interior.Color = RGB(0, 0, 255)
      end if
      sólo cambia los valores de la función RGB(rojo, verde, azul).

      Esa misma estructura serviría para otros casos en los que los valores sean diferentes a los de la gráfica.
      Slds

      Eliminar
    2. Quise realizar este ejemplo sin embargo no me funcionó por mas que intente, solo me sirvió el ejemplo inicial. Lo que quiero es que la barras cambien en 3 condicionante: color rojo si tiene valores entre 0-79, amarillo si tiene valores entre 80-89 y verde si tiene valores entre 90-100 o mas. te adjunto el archivo a tu correo para que me lo modifique, lo tengo hasta el primer ejemplo que nos pusiste al inicio. de ante mano te agradezco la ayuda

      Eliminar
    3. Hola Randall,
      te he contestado a través del correo que me has mandado, adjuntado la solución (una mendiante SELECT CASE y otra añadiendo más condiciones IF THEN)

      Slds

      Eliminar
    4. GRACIAS ME FUNCIONO DE LAS 2 MANERA AL 100%

      DEJO EL CODIGO PARA LOS QUE ANDAN BUSCANDO LO MISMO QUE YO:
      CON LA OPCION IF THEN:

      'ejecuta macro al modificar alguna celda en la Hoja1
      Sub worksheet_change(ByVal target As Range)
      'definimos las variables que emplearemos en el desarrollo de la macro
      Dim Pto As Long
      Dim Val As Variant
      Dim nombrehoja, rangocelda As String
      'asignamos a las variables nombrehoja y rangocelda un valor
      nombrehoja = ActiveSheet.Name
      rangocelda = ActiveCell.Address
      'el siguiente código controla el valor de cada barra de nuestro gráfico
      'y le asigna un color (rojo o azul)
      ActiveSheet.ChartObjects("1 Gráfico").Activate
      With ActiveChart.SeriesCollection(1)
      Val = .Values
      For Pto = 1 To UBound(Val)
      If Val(Pto) <= 79 Then .Points(Pto).Interior.Color = vbRed
      If Val(Pto) > 79 And Val(Pto) <= 89 Then .Points(Pto).Interior.Color = vbYellow
      If Val(Pto) > 89 Then .Points(Pto).Interior.Color = vbGreen

      Next Pto
      End With

      'termina la macro devolviéndonos a una celda activa de la Hoja de cálculo activa
      Sheets(nombrehoja).Range(rangocelda).Select
      End Sub


      CON LA OPCION SELECT:

      'ejecuta macro al modificar alguna celda en la Hoja1
      Sub worksheet_change(ByVal target As Range)
      'definimos las variables que emplearemos en el desarrollo de la macro
      Dim Pto As Long
      Dim Val As Variant
      Dim nombrehoja, rangocelda As String
      'asignamos a las variables nombrehoja y rangocelda un valor
      nombrehoja = ActiveSheet.Name
      rangocelda = ActiveCell.Address
      'el siguiente código controla el valor de cada barra de nuestro gráfico
      'y le asigna un color (rojo o azul)
      ActiveSheet.ChartObjects("1 Gráfico").Activate
      With ActiveChart.SeriesCollection(1)
      Val = .Values
      For Pto = 1 To UBound(Val)
      Select Case Val(Pto)
      Case Is <= 79: .Points(Pto).Interior.Color = vbRed
      Case 79 To 89: .Points(Pto).Interior.Color = vbYellow
      Case Else: .Points(Pto).Interior.Color = vbGreen
      End Select

      Next Pto
      End With

      'termina la macro devolviéndonos a una celda activa de la Hoja de cálculo activa
      Sheets(nombrehoja).Range(rangocelda).Select
      End Sub



      Eliminar
    5. Muchas gracias Randall...
      la verdad, tendría que haberlo subido yo mismo ;-)

      Deben ser los años je, je..
      Un cordial saludo

      Eliminar
    6. Este comentario ha sido eliminado por el autor.

      Eliminar
  13. ok, muchas gracias
    pero a lo otro que me referìa era que tengo ventas diarias en una gràfica y una tabla; y en otra tabla en la misma hoja tengo causas posibles por las cuales las ventas fueron bajas ese dìa:
    por ejemplo
    1.-no vino (azul)
    2.- mal clima (rojo)
    etc

    querìa saber si es posible que los colores de la gràfica de ventas diaria esten condicionados por los datos que aparecen en la otra tabla

    ResponderEliminar
    Respuestas
    1. Hola David,
      en principio parece posible.
      Habría que definir una variable de color en función a los valores de la otra tabla:
      if valor tabla = xxx then variable1=RGB(0;0;255)
      if valor tabla = yyy then variable1=RGB(0;255;255)
      etc
      para luego usar esas variables condicionadas de color para los valores del gráfico,
      IF Val(Pto) > 0 AND Val(Pto) <=1 then .Points(Pto).Interior.Color = variable1

      Slds

      Eliminar
  14. Ok, muchas gracias

    pero entonces el rango de celdas donde viene que color poner le asigno un nombre, digamos condicion, y en VBA pongo:
    if condicion = xxx then variable1=RGB(0;0;255)

    no se mucho de macros, por eso te pregunto, aparte estoy usando otro macro con el cual la gràfica muestra solo las ventas del vendedor actualmente seleccionado

    ¿Los dos còdigos se pueden poner en el mismo Private Sub Worksheet_SelectionChange(ByVal Target As Range)?


    muchas rgacias y disculpa las molestias

    ResponderEliminar
  15. ya probe los dos programas juntos y si funcionan

    ResponderEliminar
    Respuestas
    1. Perfecto David,
      me alegro te haya funcionado.
      disculpa tú, pero a veces las preguntas que realizáis son demasiado generales, sobre todo cuando delante no tienes el código ni la plantilla de la hoja para poder comprender exactamente las cuestiones planteadas.
      Un cordial saludo

      Eliminar
  16. enterado, querìa poner el archivo, pero no veo el botòn para adjuntar archivos, o te lo mando a tù correo?

    ResponderEliminar
    Respuestas
    1. Hola David,
      no es posible adjuntar ficheros en los comentarios de Blogger.
      Si necesitas algo más concreto y prefieres adjuntar un fichero excel con un ejemplo, puedes enviarlo a
      excelforo@gmail.com

      Slds

      Eliminar
  17. Este comentario ha sido eliminado por el autor.

    ResponderEliminar
  18. AL momento de poner en rango de celda pongo asi BO17: BR17 as string, pero me marca error de statement invalid outside type block, de que otra manera puedo declarar el rango
    Saludos y gracias

    ResponderEliminar
    Respuestas
    1. Hola Rossy,
      los rangos es mejor definirlos como variable tipo Range.
      Por ejemplo,
      Dim rng as Range
      rng=range("BO17:BR17")

      Slds

      Eliminar
  19. Hola queria saber si es posible adaptar la macro para cuando encuentre dos datos de texto iguales les pnga el mismo color si no, de diferentes colores. Gracias

    ResponderEliminar
    Respuestas
    1. Hola,
      si no son muchos los puntos de la Serie de datos, se podría hacer con un doble FOR.
      For Pto = 1 To UBound(Val)
      For Pto2=1 to UBound(Val)
      If Val(Pto) = Val(Pto2) Then
      .Points(Pto).Interior.Color = RGB(255, 0, 0)
      Else: .Points(Pto).Interior.Color = RGB(0, 0, 255)
      End If
      Next Pto2
      Next Pto

      Slds

      Eliminar
  20. Estimado
    Mi consulta es la siguiente ¿Cómo puedo programar en una hoja de excel que dadas ciertas condiciones aparezca o no un gráfico? Trabajo en una base de datos que genera gráficos automáticamente con la que confecciono un informe modelo pero no en todas las hojas necesito todos los gráficos.

    ResponderEliminar
    Respuestas
    1. Hola,
      tendrías que verificar la condición que sea con:
      IF condición THEN
      'dependiendo de lo que quieras
      'hace visible el gráfico 1
      ActiveSheet.ChartObjects("1 Gráfico").Visible = True
      'oculta el gráfico 1
      ActiveSheet.ChartObjects("1 Gráfico").Visible = False
      END IF
      Slds

      Eliminar
  21. Hola:
    tengo una tabla con tres columnas(nombre, f, acum), lo he graficado como barras (nombre en "x" y f en "y"), sin embargo quiero lograr colorear deacuerdo a un criterio de la columna "acum", como lo hago?

    ResponderEliminar
    Respuestas
    1. Hola Arturo,
      puedes optar por emplear una macro como la que explico en este mismo post, o bien hacerlo sin macros como comento en
      http://excelforo.blogspot.com.es/2010/11/grafico-de-barras-en-excel-condicionado.html
      Sólo tienes que modificar mínimamente la condición...
      lo más sencillo sería la segunda opción, haciendo las fórmulas condicionales según el criterio de la columna 'acum'.
      Slds

      Eliminar
  22. Buenas tardes si deseo que tenga efecto sobre mas de una serie como debo hacer,son 5 series

    ResponderEliminar
    Respuestas
    1. Hola,
      si son sólo 5 seríes, podrías hacer en la misma macro esta pequeña adaptación:
      for i=1 to 5
      With ActiveChart.SeriesCollection(i)
      Val = .Values
      For Pto = 1 To UBound(Val)
      If Val(Pto) <= 2.4 Then
      .Points(Pto).Interior.Color = RGB(255, 0, 0)
      Else: .Points(Pto).Interior.Color = RGB(0, 0, 255)
      End If
      Next Pto
      End With
      Next i

      Te debería funcionar sin problemas...
      Espero te sirva
      Slds

      Eliminar
    2. Me ha servido perfecto,si quisiera rizar el rizo y que en la tabla cambiara el color en funcion de un punto tipo (x,y)es decir cin dos coordenadas?

      muchas gracias

      Eliminar
    3. Hola,
      supongo hablamos de un gráfico de dispersión...
      en ese caso te recomendaría emplearas inicialmente el asistente para ver qué código genera para este tipo de gráfico, y así poder actuar sobre él.
      El problema de los gráficos es que cada tipo tiene sus particularidades, y al final para modificarlo desde VBA o te dedicas en exclusiva a programar o no te queda más remedio que probar...

      Si quieres, tras probar, puedes enviarme un ejemplo a
      excelforo@gmail.com
      y le echo un vistazo, e intento darte una solución.
      Slds cordiales

      Eliminar
    4. me referia a un grafico de bolas en el qeu cuando una valor este por debajo de una zona del eje x,y la bola cambie de color

      Eliminar
    5. Lo dicho...
      pero en esencia sería lo mismo que la entrada...

      Eliminar
  23. buenas tardes, estoy creando dos diagramas de barras desde vb, pero me los dibuja en la misma area,
    necesito las dos gráficas en la misma hoja, el codigo es este

    Set chartsTemp = ActiveSheet.ChartObjects
    If chartsTemp.Count > 0 Then
    chartsTemp(chartsTemp.Count).Delete
    End If

    Set D3 = Range(Cells(15, 169), Cells(15, 181))
    Set D6 = Range(Cells(celda + 1, 169), Cells(celda + 1, 181))

    Set D7 = Range(Cells(15, 169), Cells(15, 181))
    Set D8 = Range(Cells(celda + 1, 169), Cells(celda + 1, 181))

    'ActiveSheet.ChartObjects(1).Activate
    'ActiveSheet.ChartObjects("Grap").Activate

    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    'ActiveSheet.ChartObjects("Gráfico 55").Activate
    ActiveChart.SetSourceData Source:=D3
    ActiveChart.SetSourceData Source:=D6
    ActiveChart.FullSeriesCollection(1).XValues = D3
    ActiveChart.ChartGroups(1).GapWidth = 0



    '**********MODIFICO CARACTERISTICAS DE LA GRAFICA

    ActiveChart.HasTitle = True
    ActiveChart.ChartTitle.Characters.Text = "PREGUNTAS X ESTUDIANTES"
    ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "RANGOS"
    ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "NÚMERO DE ESTUDIANTES"
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
    ActiveChart.SetElement (msoElementDataLabelInsideBase)
    ActiveChart.SetElement (msoElementDataLabelCenter)

    '************AREA DE IMPRESIÓN***********

    Set zona = Range("FA60:FB72")
    With ActiveSheet.ChartObjects
    .Top = zona.Top
    .Left = zona.Left
    .Width = zona.Width
    .Height = zona.Height
    End With
    'End If

    '******** aqui creo la otra grafica
    ActiveSheet.Shapes.AddChart2(301, xlColumnClustered).Select
    'ActiveSheet.ChartObjects("Gráfico 56").Activate
    ActiveChart.SetSourceData Source:=D7
    ActiveChart.SetSourceData Source:=D8
    ActiveChart.FullSeriesCollection(1).XValues = D7
    ActiveChart.ChartGroups(1).GapWidth = 0


    Set zona = Range("FC60:FG72")
    With ActiveSheet.ChartObjects
    .Top = zona.Top
    .Left = zona.Left
    .Width = zona.Width
    .Height = zona.Height
    End With

    ResponderEliminar
    Respuestas
    1. Hola Caterine,
      he probado tu código y si que crea dos gráficos de columnas... el posible problema es que te los superpone, uno encima de otro, ya que trabajas siempre con ActiveChart, y con ActiveSheet.ChartObjects lo que hace que que ambos gráficos los situe en la misma zona.

      Intenta identificar cada gráfico antes de realziar cambios sobre él. Emplea sus Índices:
      With ActiveSheet.ChartObjects(1)
      ....

      With ActiveSheet.ChartObjects(2)
      ....

      Espero te oriente
      Slds

      Eliminar
  24. Buenos días, tengo una situación similar a la que plantearon con Randal en agosto 30 de 2012. Necesito que los colores de las barras estén sujetos al resultado de 3 rangos 0-100, 100 y mayor a 100. Me puedes ayudar enviandome el archivo de Excel para aplicarlo en mi caso. Correo lbernalv@live.com.co
    Gracias,

    Luis Bernal

    ResponderEliminar
    Respuestas
    1. Hola Luís,
      no tengo tal fichero.. simplemente copia el código expuesto en tal comentario y aplícalo.
      Si tuvieras algún problema coméntamelo,.
      Slds cordiales

      Eliminar
  25. Ismael, definitivamente no pude ingresar esa programación. Pero tengo otra inquietud. Grabé una macro para borrar las etiquetas de datos que no necesito en gráficos de columnas apiladas. Necesito que la macro lo repita con todas las gráficas y que solo lo haga con las que sean igual a "0". Este es el código básico. Tu me ayudas a definir donde iría la condición y qué tipo de condición debo ponerle:

    Sub Ceros()
    '
    ' Ceros Macro
    '
    ' Acceso directo: Ctrl+Mayús+C
    '
    ActiveWindow.SmallScroll Down:=9
    ActiveSheet.ChartObjects("1 Gráfico").Activate
    ActiveChart.SeriesCollection(4).DataLabels.Select
    ActiveChart.SeriesCollection(4).Points(2).DataLabel.Select
    Selection.Delete
    ActiveSheet.ChartObjects("1 Gráfico").Activate
    ActiveChart.SeriesCollection(3).DataLabels.Select
    ActiveChart.SeriesCollection(3).Points(2).DataLabel.Select
    Selection.Delete
    ActiveWindow.SmallScroll Down:=-27
    End Sub


    Mil gracias,
    Luis

    ResponderEliminar
    Respuestas
    1. Hola Luís,
      el código sería casi idéntico al mostrado en el post:
      Sub worksheet_change(ByVal target As Range)
      Dim Pto As Long
      Dim Val As Variant
      Dim nombrehoja, rangocelda As String
      nombrehoja = ActiveSheet.Name
      rangocelda = ActiveCell.Address

      ActiveSheet.ChartObjects("1 Gráfico").Activate
      With ActiveChart.SeriesCollection(1)
      Val = .Values
      For Pto = 1 To UBound(Val)
      If Val(Pto) = 0 Then
      .Points(Pto).HasDataLabel = False
      Else
      .Points(Pto).HasDataLabel = True
      End If
      Next Pto
      End With

      Sheets(nombrehoja).Range(rangocelda).Select
      End Sub

      Como ves la propiedad es .HasDataLabel =True o =False empleando el condicional IF THEN.

      Slds

      Eliminar
  26. Genial!! Me funcionó, pero te molesto con otro detallito.... La gráfica tiene 4 series de datos compilados y necesito que replique borrar los "0" en las otras series. Cuando duplico la parte del proceso (cambiándole el número de la serie de datos) me dice que la variable de control For ya está en uso. Me apena molestarte tanto porque soy muy novato en esto, pero estoy a un tantito de lograrlo.

    Te aradezco mucho...

    ResponderEliminar
    Respuestas
    1. Hola,
      Prueba con
      ....
      For serie=1 to 4
      With ActiveChart.SeriesCollection(serie)
      Val = .Values
      For Pto = 1 To UBound(Val)
      If Val(Pto) = 0 Then
      .Points(Pto).HasDataLabel = False
      Else
      .Points(Pto).HasDataLabel = True
      End If
      Next Pto
      End With
      Next serie
      ....

      Debería resultar sin problemas
      Slds

      Eliminar
    2. Ismael: sos grande!!! funcionó perfecto. Mil y mil gracias!!!

      Eliminar
    3. ;-)
      me alegra funcionara como esperabas.
      Slds cordiales

      Eliminar
  27. Estimado, tu aporte me interesa bastante, quiero probar pero no entiendo cuando te refieres a tener que programar en la hoja ? ..

    Lo que hago es ir a la hoja 1 y darle la opción ver código ingreso los datos que se muestran en tu aporte pero no logro realizar el evento, me podrías ayudar?

    ResponderEliminar
    Respuestas
    1. Hola Giancarlo,
      es correcto lo que dices.
      Si no te funciona podría ser que tu gráfico no se llame '1 Gráfico'... asegúrate de esto y comentas.
      Slds cordiales

      Eliminar
  28. Es muy cierto, gracias por la ayuda.

    Ahora tengo otro inconveniente, estuve investigando pero por el momento no encuentro la solución, quizás tu podrías ayudarme.

    Si bien el código pinta según valores solo para gráficos de Barras y Pie, a mi me interesa que estos cambios se realicen en una gráfico de Lineas.

    Sabes como puedo hacerlo ?

    ResponderEliminar
    Respuestas
    1. Hola Giancarlo,
      en principio un gráfico de línea pinta de un mismo color toda la línea.. no veo posible poner cada tramo de línea de diferentes colores...

      Ten en cuenta que cada tipo de gráfico tiene sus particularidades, y que el tratamiento por tanto no puede ser equiparable.

      De todas formas investigaré...
      Slds

      Eliminar
  29. Ismael.

    De no ser posible el pintado de las lineas, puede ser que las intersecciones del eje X con el Y, que juntas forman un punto, ese punto puede ser pintado'?

    ResponderEliminar
    Respuestas
    1. Hola Giancarlo,
      los ejes pueden ser formateados con un color (a elegir), pero para 'pintar' la intersección de un color, tendrías que engañar a Excel, generando un punto ficticio, un par ordenado 0,0, para luego seleccionarlo y desde formato de Serie de puntos cambiarle el color...
      Quizá te sirva la idea
      Saludos

      Eliminar
    2. Estimado estuve investigando y encontré algo parecido a lo que estoy buscando, pero resulta que este ejercicio te muestra un color o colores degradados que lo que no estoy buscando.

      Como sabrás me encuentro buscando un código que me ayude a pintar una gráfica de líneas, haber si me puede ayudar.

      Sub formSeriesPoint()

      Dim lP As Long
      Dim lNrofPoints As Long
      Dim dStep As Double
      Dim rgbRedStartValue, rgbGreenStartValue, rgbBlueStartValue
      Dim dRedStep As Double, dGreenStep As Double, dBlueStep As Double

      If ActiveChart Is Nothing Then
      MsgBox "Seleccione el grafico a modificar", vbCritical, "Grafico activo"
      Exit Sub
      End If


      lNrofPoints = ActiveChart.SeriesCollection(1).Points.Count
      dStep = 256 / lNrofPoints

      With ufRGB
      .Show


      'establecer valor del color y del step para cada color

      Select Case .cbxRojo
      Case Is = 255
      rgbRedStartValue = .cbxRojo.Value
      dRedStep = dStep * -1
      Case Is = 0
      rgbRedStartValue = .cbxRojo.Value
      dRedStep = dStep
      Case Is = "255-K"
      rgbRedStartValue = 255
      dRedStep = 0
      Case Is = "0-K"
      rgbRedStartValue = 0
      dRedStep = 0
      End Select

      Select Case .cbxVerde
      Case Is = 255
      rgbGreenStartValue = .cbxVerde.Value
      dGreenStep = dStep * -1
      Case Is = 0
      rgbGreenStartValue = .cbxVerde.Value
      dGreenStep = dStep
      Case Is = "255-K"
      rgbGreenStartValue = 255
      dGreenStep = 0
      Case Is = "0-K"
      rgbGreenStartValue = 0
      dGreenStep = 0
      End Select

      Select Case .cbxAzul
      Case Is = 255
      rgbBlueStartValue = .cbxAzul.Value
      dBlueStep = dStep * -1
      Case Is = 0
      rgbBlueStartValue = .cbxAzul.Value
      dBlueStep = dStep
      Case Is = "255-K"
      rgbBlueStartValue = 255
      dBlueStep = 0
      Case Is = "0-K"
      rgbBlueStartValue = 0
      dBlueStep = 0
      End Select
      End With

      Unload ufRGB

      For lP = 1 To lNrofPoints
      ActiveChart.SeriesCollection(1).Points(lP).Format.Fill. _
      ForeColor.RGB = RGB(rgbRedStartValue + (dRedStep * (lP - 1)), _
      rgbGreenStartValue + (dGreenStep * (lP - 1)), _
      rgbBlueStartValue + (dBlueStep * (lP - 1)))
      Next lP

      End Sub

      Eliminar
    3. Hola Giancarlo,
      por que no purebas simplemente la funcionalidad de Variar colores entre puntos??
      echa un vistazo a
      http://excelforo.blogspot.com.es/2013/06/variar-colores-entre-puntos-de-una.html
      y sin macros...

      Saludos

      Eliminar
  30. Hola Ismael, he utilizado tu código y modificado un par de cosas para aplicarlo a varios gráficos en la misma hoja. El conflicto que presento es que mis valores se actualizan por fórmula y el cambio de color sólo se aplica si hago modificaciones a la celda origen. Podrías ayudarme para corregir y que considere los cambios de valor sin la necesidad de entrar a la celda? Adjunto código completo:
    'ejecuta macro al modificar alguna celda en la Hoja1
    Sub worksheet_change(ByVal target As Range)
    'definimos las variables que emplearemos en el desarrollo de la macro
    Dim Pto As Double
    Dim Val As Variant
    Dim nombrehoja, rangocelda As String
    Dim hojagraficos As Worksheet
    'asignamos a las variables nombrehoja y rangocelda un valor
    nombrehoja = ActiveSheet.Previous.Name
    rangocelda = ActiveCell.Address
    Set hojagraficos = Sheets(nombrehoja)
    'el siguiente código controla el valor de cada barra de nuestro gráfico
    'y le asigna un color (rojo o azul)
    hojagraficos.Activate
    hojagraficos.ChartObjects("CONG_LD").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.ChartObjects("CONG_MT").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.ChartObjects("REF_LD").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.ChartObjects("REF_MT").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    'termina la macro devolviéndonos a una celda activa de la Hoja de cálculo activa
    Sheets(nombrehoja).Range(rangocelda).Select
    Set hojagraficos = Nothing
    End Sub

    ResponderEliminar
    Respuestas
    1. Hola,
      el problema de esto es que al lanzar una macro con un evento Change (como tu has hecho).. estás supeditado a que se cambie o modifique una celda de tu hoja...
      podrías probar con un evento
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      ....

      así cada vez que hagas una selección de una celda se reproduciría el procedimiento.. aunque quizá esto no sea lo más práctico, ya que se lanzaría constantemente en cada selección.

      Espero orientarte.
      Saludos

      Eliminar
  31. Hola! he modificado un poco el código y he asignado la macro a un cuadro de lista (que es el que genera el cambio de datos en el rango de datos para el gráfico) y con cada cambio se ejecuta de manera adecuada. Con ello los colores cambian con cada selección nueva en el cuadro:

    'ejecuta macro al modificar alguna celda en la Hoja1
    Sub Actualizar_graficos()
    'definimos las variables que emplearemos en el desarrollo de la macro
    Dim Pto As Double
    Dim Val As Variant
    Dim nombrehoja, rangocelda As String
    Dim hojagraficos As Worksheet

    Application.Calculation = xlCalculationAutomatic


    'asignamos a las variables nombrehoja y rangocelda un valor
    nombrehoja = "Dashboard"
    Set hojagraficos = Sheets(nombrehoja)
    'el siguiente código controla el valor de cada barra de nuestro gráfico
    'y le asigna un color (rojo, amarillo o verde)

    hojagraficos.Activate
    hojagraficos.ChartObjects("CONG_LD").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.ChartObjects("CONG_MT").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.ChartObjects("REF_LD").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.ChartObjects("REF_MT").Activate
    With ActiveChart.SeriesCollection(1)
    Val = .Values
    For Pto = 1 To UBound(Val)
    If Val(Pto) <= 0.79 Then .Points(Pto).Interior.Color = vbRed
    If Val(Pto) > 0.79 And Val(Pto) <= 0.89 Then .Points(Pto).Interior.Color = vbYellow
    If Val(Pto) > 0.89 Then .Points(Pto).Interior.Color = vbGreen

    Next Pto
    End With

    hojagraficos.Calculate

    Set hojagraficos = Nothing


    End Sub

    Gracias por tu ayuda,
    Saludos.

    ResponderEliminar
  32. hola, disculpen la molestia pero agradeceria su apoyo para realizar una macro que me dibuje (ubique, coloque) varios puntos (x,y,z) en una de las caras superiores de un cubo 3d, es decir, la idea es tomar un vértice de una de las caras de un cubo y seleccionar los ejes, x, y, y z, y de ellos poder hacer la ubicación de los diferentes puntos (x,y,z) que queramos.

    ResponderEliminar
    Respuestas
    1. Hola Aureo
      trataré de subir una explicación al blog en cuanto me sea posible...

      Un saludo

      Eliminar
  33. hola, disculpe la molestia, cual seria el procedimiento para al hacer clic en un punto cualquiera del grafico, la información de este se muestre en una celda, como por ejemplo la fecha.

    ResponderEliminar
    Respuestas
    1. Hola,
      no existe, que yo conozca, un evento similar a lo que planteas sobre los gráficos...
      imagino habría que generarlo en un modulo de clase y luego emplearlo en uno estándar. Sería bastante complejo...
      Saludos

      Eliminar

Nota: solo los miembros de este blog pueden publicar comentarios.