Copiamdo de un sitio y de otro, he preparado una macro que consigue hacer casi todo lo que yo deseo. Se trata de insertar un gráfico en una hoja nueva. El resultado final es el deseado (o casi). Sin embargo, hay dos cosas que no he logrado.
La primera, quiero que la nueva hoja tenga un nombre que pueda variarlo sin entrar en la macro. Eso lo hace. No obstante, en una segunda parte de la macro no sé como hacer para que me funcione esto mismo.
En esta es la que no puedo sacar el nombre fuera de la macro.
'Cambiar el color de la barra en función del valor decidido
Set sht = Sheets("Datos1")
sht.Select
Set StartCell = Range("c6")
Charts("P100").Select With ActiveChart.FullSeriesCollection(1)
Val = .Values
For Pto = 1 To UBound(Val)
If Val(Pto) > Sheets("Datos1").Range("f1") Then
.Points(Pto).Interior.Color = RGB(100, 100, 100)
ElseIf Val(Pto) > Sheets("Datos1").Range("f2") Then
.Points(Pto).Interior.Color = RGB(150, 150, 150)
Else: .Points(Pto).Interior.Color = RGB(200, 200, 200)
End If
Next Pto
End With
La segunda es eliminar el borde del gráfico. Siguiendo los pasos que realiza el grabador de macros del programa no funciona.
Buenos días.
Copiamdo de un sitio y de otro, he preparado una macro que consigue hacer casi todo lo que yo deseo. Se trata de insertar un gráfico en una hoja nueva. El resultado final es el deseado (o casi). Sin embargo, hay dos cosas que no he logrado.
La primera, quiero que la nueva hoja tenga un nombre que pueda variarlo sin entrar en la macro. Eso lo hace. No obstante, en una segunda parte de la macro no sé como hacer para que me funcione esto mismo.
Con este se pone el nombre de la hoja.
'Establece el tipo de grafico
ActiveSheet.Shapes.AddChart2(216, xlBarClustered).Select
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveChart.Name = Sheets("Datos1").Range("h1")
En esta es la que no puedo sacar el nombre fuera de la macro.
'Cambiar el color de la barra en función del valor decidido
Set sht = Sheets("Datos1")
sht.Select
Set StartCell = Range("c6")
Charts("P100").Select
With ActiveChart.FullSeriesCollection(1)
Val = .Values
For Pto = 1 To UBound(Val)
If Val(Pto) > Sheets("Datos1").Range("f1") Then
.Points(Pto).Interior.Color = RGB(100, 100, 100)
ElseIf Val(Pto) > Sheets("Datos1").Range("f2") Then
.Points(Pto).Interior.Color = RGB(150, 150, 150)
Else: .Points(Pto).Interior.Color = RGB(200, 200, 200)
End If
Next Pto
End With
La segunda es eliminar el borde del gráfico. Siguiendo los pasos que realiza el grabador de macros del programa no funciona.
Gracias de antemano por vuestra ayuda,
Ignacio
A2.xlsm