Excel Gráfico Sextante – Gráfico Setores RH

Objetivo: Demonstrar a criação de um gráfico de setores de forma automática utilizando VBA.

Este artigo demonstra um gráfico de avaliação de colaboradores de uma empresa (cada número um funcionário) para definir quais são os talentos que devem ser retidos e outros que tem que ser trabalhados na empresa.

Os números mais altos nos eixos X e Y definem que o funcionário está mais ou menos preparado para a empresa, conforme o gráfico.

O problema na criação deste gráfico era criar automaticamente os pontos, dado que neste tipo de gráfico não havia como simplesmente selecionar uma lista, pois ele criaria vários pontos ligados por linhas (gráfico base).

Códigos utilizados:

Sub lsPreencheGrafico()

    Dim lUltimaLinhaAtiva   As Long
    Dim i                   As Long
    lUltimaLinhaAtiva = Worksheets("Plan2").Cells(Worksheets("Plan2").Rows.Count, 1).End(xlUp).Row

    ActiveSheet.ChartObjects("Gráfico 1").Activate

    RemoveSeries

    For i = 2 To lUltimaLinhaAtiva
        ActiveSheet.ChartObjects("Gráfico 1").Activate
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection(Range("Plan2!A" & i).Value).Name = "='Plan2'!$A$" & i
        ActiveChart.SeriesCollection(Range("Plan2!A" & i).Value).XValues = "='Plan2'!$B$" & i
        ActiveChart.SeriesCollection(Range("Plan2!A" & i).Value).Values = "='Plan2'!$C$" & i
        Range("M4").Select
    Next
    
    lsFormataGrafico
End Sub

Sub lsFormataGrafico()

    Dim lUltimaLinhaAtiva   As Long
    Dim i                   As Long
    Dim lAtual              As Long
    lUltimaLinhaAtiva = Worksheets("Plan2").Cells(Worksheets("Plan2").Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lUltimaLinhaAtiva
    
        lAtual = Range("Plan2!A" & i).Value
    
        ActiveSheet.ChartObjects("Gráfico 1").Activate
        ActiveChart.SeriesCollection(lAtual).ApplyDataLabels
        ActiveChart.SeriesCollection(lAtual).DataLabels.ShowSeriesName = True
        ActiveChart.SeriesCollection(lAtual).DataLabels.ShowValue = False
        ActiveChart.SeriesCollection(lAtual).DataLabels.Select
        ActiveChart.SeriesCollection(lAtual).DataLabels.ShowSeriesName = True
        ActiveChart.SeriesCollection(lAtual).DataLabels.Position = xlLabelPositionCenter
        ActiveChart.SeriesCollection(lAtual).DataLabels.Font.ColorIndex = 2
        
        ActiveSheet.ChartObjects("Gráfico 1").Activate
        ActiveChart.SeriesCollection(lAtual).Select
        Selection.MarkerSize = 25
        Selection.MarkerStyle = 8
        ActiveChart.SeriesCollection(lAtual).Format.Fill.ForeColor.RGB = rgbBlack
        ActiveChart.SeriesCollection(lAtual).Format.Line.ForeColor.RGB = rgbBlack
    Next
End Sub

Sub RemoveSeries()
    With ActiveChart
        Do Until .SeriesCollection.Count = 0
            .SeriesCollection(1).Delete
        Loop
    End With
End Sub

Até a próxima

Marcos Rieper

Baixe a planilha