Excel Gráfico Sextante – Gráfico Setores RH

Calculadora em VBA
Calculadora em VBA
16 de novembro de 2010
Space Invaders no Excel
Space Invaders no Excel
23 de novembro de 2010

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

 


Clique aqui e leia mais sobre Excel VBA. https://www.guiadoexcel.com.br/vba/ O Guia do Excel foi criado por Marcos Rieper e oferece artigos, dicas, tutoriais e modelos de planilhas prontas. Aqui você encontra tudo sobre Excel, seja de nível básico, intermediário,  avançado e VBA. O Guia do Excel oferece diversos materiais completamente gratuitos para download. Navegue em nosso site e confira! Conheça também a nossa Loja do Excel https://loja.guiadoexcel.com.br/

3 Comentários

  1. Gilson Pereira disse:

    Prezado Marcos,

    Não consegui fazer download do modelo de planilha deste post (Gráfico de Setores RH).

    Se não for incomodo solicito por gentileza o envio da mesma para mim.

    Agradeço antecipadamente.

    Obs.: Grande Blog com excelentes matérias e tutoriais.

  2. rafael disse:

    boa tarde, alguem ja pessou em fazer um grupo no whatsapp para falar so sobre excel e tirar alguma duvidas?

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.