Jump to content

Chart com OptionButton


Recommended Posts

Boas,

Tenho estado a desenvolver uma macro que agora decidi, optar por colocar os dados em gráfico, só que quando clico nos OptionButton, ele não me elimina a serie de dados anterior e actualiza para a nova como eu pretendia.

Caso alguem me consiga ajudar fico agradecido. 🙂

Já agora aproveito a oportunidade para questionar como posso fazer aqui para anexar ficheiro se é que é possivel.

Código:

Option Explicit
Dim LasRow, x, y As Long
Dim Titulares()
Dim Taxas()
Dim TaxaMedia()
Dim chConstantes
Dim serSeries1, serSeries2
Dim dlSeries1Labels
Dim axValueAxis
Private Sub MultiPage1_Enter()
Set chConstantes = ChartSpace1.Constants
ChartSpace1.Charts(0).SeriesCollection.Add
Set serSeries1 = ChartSpace1.Charts(0).SeriesCollection(0)
ChartSpace1.Charts(0).SeriesCollection.Add
ChartSpace1.Charts(0).SeriesCollection(1).Type = chConstantes.chChartTypeLine
Set serSeries2 = ChartSpace1.Charts(0).SeriesCollection(1)
Set dlSeries1Labels = serSeries1.DataLabelsCollection.Add
Set axValueAxis = ChartSpace1.Charts(0).Axes(1)
LastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
ReDim Titulares(LastRow - 8)
ReDim Taxas(LastRow - 8)
ReDim TaxaMedia(LastRow - 8)
For x = 8 To LastRow
Titulares(y) = Cells(x, 1).Value
If OptTxIliq.Value = True Then
	Taxas(y) = Cells(x, 3).Value
	TaxaMedia(y) = Cells(1, 3).Value
	y = y + 1
Else
	Taxas(y) = Cells(x, 4).Value
	TaxaMedia(y) = Cells(2, 3).Value
	y = y + 1
End If
Next x
serSeries1.SetData chConstantes.chDimCategories, chConstantes.chDataLiteral, Titulares
serSeries1.SetData chConstantes.chDimValues, chConstantes.chDataLiteral, Taxas
serSeries2.SetData chConstantes.chDimValues, chConstantes.chDataLiteral, TaxaMedia
dlSeries1Labels.NumberFormat = "0.00" & "%"
dlSeries1Labels.HasValue = True
axValueAxis.NumberFormat = "Percent"
With ChartSpace1.Charts(0)
With .Axes(1)
	.HasTitle = True
	.Title.Caption = "Taxas de Juro"
End With
With .Axes(0)
	.HasTitle = True
	.Title.Caption = "Titulares"
End With
.HasTitle = True
.Title.Caption = "Desempenho Global das Aplicações"
.HasLegend = True
.SeriesCollection(0).Caption = "Taxas Médias Por Titular"
.SeriesCollection(1).Caption = "Taxa Média Global de Todas as Aplicações" _
& " " & FormatPercent(Cells(1, 3).Value)
End With
With Me.MultiPage1
.Width = Application.Width
.Height = Application.Height
End With
y = 0
End Sub
Private Sub OptTxIliq_change()

  Call MultiPage1_Enter
End Sub
Private Sub OptTxLiq_Click()
Call MultiPage1_Enter
End Sub
Private Sub UserForm_Initialize()
With Me
.Width = Application.Width
.Height = Application.Height
End With
MultiPage1.Value = 0
End Sub
Link to comment
Share on other sites

Caros Amigos,

Já achei o problema, estava a colocar o indice errado quando pedia para apagar a serie. 🙂

Segue o código corrigido.

No entanto ainda tenho interesse em saber como anexar fichaeiros se for possivel.

Obrigado para que deu uma vista de olhos.

Option Explicit
Dim LasRow, x, y As Long
Dim Titulares()
Dim Taxas()
Dim TaxaMedia()
Dim chConstantes
Dim serSeries1, serSeries2
Dim dlSeries1Labels
Dim axValueAxis
Private Sub MultiPage1_Enter()
Set chConstantes = ChartSpace1.Constants
ChartSpace1.Charts(0).SeriesCollection.Add
Set serSeries1 = ChartSpace1.Charts(0).SeriesCollection(0)
ChartSpace1.Charts(0).SeriesCollection.Add
ChartSpace1.Charts(0).SeriesCollection(1).Type = chConstantes.chChartTypeLine
Set serSeries2 = ChartSpace1.Charts(0).SeriesCollection(1)
Set dlSeries1Labels = serSeries1.DataLabelsCollection.Add
Set axValueAxis = ChartSpace1.Charts(0).Axes(1)
LastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
ReDim Titulares(LastRow - 8)
ReDim Taxas(LastRow - 8)
ReDim TaxaMedia(LastRow - 8)
For x = 8 To LastRow
   Titulares(y) = Cells(x, 1).Value
   If OptTxIliq.Value = True Then
    Taxas(y) = Cells(x, 3).Value
    TaxaMedia(y) = Cells(1, 3).Value

 Else
    Taxas(y) = Cells(x, 4).Value
    TaxaMedia(y) = Cells(2, 3).Value
   End If

   y = y + 1
Next x
serSeries1.SetData chConstantes.chDimCategories, chConstantes.chDataLiteral, Titulares
serSeries1.SetData chConstantes.chDimValues, chConstantes.chDataLiteral, Taxas
serSeries2.SetData chConstantes.chDimValues, chConstantes.chDataLiteral, TaxaMedia
dlSeries1Labels.NumberFormat = "0.00" & "%"
dlSeries1Labels.HasValue = True
axValueAxis.NumberFormat = "Percent"
With ChartSpace1.Charts(0)
   With .Axes(1)

    .HasTitle = True

    If OptTxIliq.Value = True Then

	    .Title.Caption = "Taxas de Juro Iliquidas"

    Else

	    .Title.Caption = "Taxas de Juro Liquidas"

    End If

   End With
   With .Axes(0)
    .HasTitle = True
    .Title.Caption = "Titulares"
   End With
   .HasTitle = True
   .Title.Caption = "Desempenho Global das Aplicações"
   .HasLegend = True
   .SeriesCollection(0).Caption = "Taxas Médias Por Titular"

   If OptTxIliq.Value = True Then

    .SeriesCollection(1).Caption = "Taxa Média Global de Todas as Aplicações" _
    & " " & FormatPercent(Cells(1, 3).Value)

   Else

    .SeriesCollection(1).Caption = "Taxa Média Global de Todas as Aplicações" _
    & " " & FormatPercent(Cells(2, 3).Value)

   End If
End With
With Me.MultiPage1
   .Width = Application.Width
   .Height = Application.Height
End With
y = 0
End Sub
Private Sub OptTxIliq_Click()
ChartSpace1.Charts(0).SeriesCollection.Delete (0)
ChartSpace1.Charts(0).SeriesCollection.Delete (0)
Call MultiPage1_Enter
End Sub
Private Sub OptTxLiq_Click()
   ChartSpace1.Charts(0).SeriesCollection.Delete (0)
   ChartSpace1.Charts(0).SeriesCollection.Delete (0)
   Call MultiPage1_Enter
End Sub
Private Sub UserForm_Initialize()
With Me
   .Width = Application.Width
   .Height = Application.Height
End With
MultiPage1.Value = 0
End Sub
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.