'Rotina para gerar gráfico rapidamente
'--------------------------------------------------
Sub GrafxyC()
'
'Rotina para gerar um gráfico de dispersão (x,y) com legendas
'

Dim i As Long    'variável apra contagem
Dim N As Long    ' número de pontos do gráfico

Dim s As Variant   ' dados de entrada
Dim nome As Variant  'nome da curva

    Set s = Selection
    nome = ActiveSheet.Name
    Charts.Add
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    ActiveChart.SetSourceData Source:=s, PlotBy:=xlColumns
    ActiveChart.Location Where:=xlLocationAsObject, Name:=nome
    With ActiveChart
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = s(0, 1)
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = s(0, 2)
    End With
    
    With ActiveChart.Axes(xlCategory)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
        .MajorTickMark = xlInside
        .MinorTickMark = xlInside
        .TickLabelPosition = xlNextToAxis
    End With
    With ActiveChart.Axes(xlValue)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
        .MajorTickMark = xlInside
        .MinorTickMark = xlInside
        .TickLabelPosition = xlNextToAxis
    End With
    With ActiveChart
        For i = 1 To .SeriesCollection.Count
            .SeriesCollection(i).Smooth = True
            .SeriesCollection(i).Name = s(0, 1 + i).Text
            .SeriesCollection(i).Format.Line.Weight = 1
            N = .SeriesCollection(i).Points.Count
            .SeriesCollection(i).Points.Item(N).HasDataLabel = True
            .SeriesCollection(i).Points(N).DataLabel.Text = ActiveChart.SeriesCollection(i).Name
        Next i
        .HasLegend = False
        If .SeriesCollection.Count > 1 Then
            .HasLegend = True
            .Legend.Position = xlLegendPositionBottom
        End If
        .PlotArea.Interior.ColorIndex = xlNone
    End With
    
    ActiveWindow.Visible = False
    ActiveChart.Parent.Cut
    s.Cells(1, 2).Select
    ActiveSheet.Paste
    s.Activate
 
End Sub
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX