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