Guia do Excel
GráficoAutomatização e VBA

Criar gráfico velocímetro automaticamente VBA Excel

MR
Marcos Rieper

Especialista em Excel

12 de julho de 2022 Atualizado 08 de julho de 2026 5 min de leitura
velocimetro excel 4

Objetivo: Disponibilizar uma macro para criar automaticamente um gráfico de velocímetro Excel VBA.

velocimetro excel 4

A criação do gráfico de velocímetro já foi explicado no artigo: http://guiadoexcel.com.br/grafico-de-ponteiro-excel.

Porém a criação deste gráfico é muito custosa, pois ela demanda um bom tempo e uma boa estrutura, dado que há tabelas padrões e cálculos a serem criados.

Como este gráfico não é nativo do Excel, criei este código VBA para criar quantos gráficos de velocímetro Excel que você precisar.

velocimetro excel 3

Para isto você só tem que seguir os passos do tutorial: http://guiadoexcel.com.br/habilitando-a-guia-desenvolvedor-e-copiando-procedimentos-vba-sub-da-internet e colar o código abaixo na sua pasta personal: 

Sub lsTabelas()
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Categoria"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Ruim"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Regular"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Bom"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "Ótimo"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Resultado"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Máximo"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "6.5"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "9"
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "10"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "8.5"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "Mostrador"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "Ruim"
    Range("A11").Select
    ActiveCell.FormulaR1C1 = "Regular"
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Bom"
    Range("A13").Select
    ActiveCell.FormulaR1C1 = "Ótimo"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "Amplitude"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "10"
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("B11").Select
    ActiveCell.FormulaR1C1 = "2.5"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "2.5"
    Range("B13").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A16").Select
    ActiveCell.FormulaR1C1 = "Agulha"
    Range("A17").Select
    ActiveCell.FormulaR1C1 = "Base"
    Range("A18").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("A19").Select
    ActiveCell.FormulaR1C1 = "=- COS(PI() * ABS(R6C2 / R9C2))"
    Range("B17").Select
    ActiveCell.FormulaR1C1 = "Extremidade"
    Range("B18").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("B19").Select
    ActiveCell.FormulaR1C1 = "=SIN(PI() * ABS(R6C2 / R9C2))"
    Range("A6:B6").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
End Sub

Sub lsPonteiro(ByVal lNomePlanilha As String, ByRef lGrafico2 As String)
    
    Dim lNome As String
    
    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
    
    lNome = Replace(ActiveChart.Name, ActiveSheet.Name & " ", "")
    lGrafico2 = lNome
    
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = "=" & lNomePlanilha & "!$A$16"
    ActiveChart.FullSeriesCollection(1).XValues = "=" & lNomePlanilha & "!$A$18:$A$19"
    ActiveChart.FullSeriesCollection(1).Values = "=" & lNomePlanilha & "!$B$18:$B$19"
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = -1
    ActiveChart.Axes(xlValue).MaximumScale = 1
    ActiveChart.Axes(xlValue).CrossesAt = 0
    ActiveChart.Axes(xlValue).MajorUnit = 0.1
    ActiveChart.Axes(xlValue).Crosses = xlAutomatic
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).MinimumScale = -1
    ActiveChart.Axes(xlCategory).MaximumScale = 1
    ActiveChart.Axes(xlCategory).CrossesAt = 0
    ActiveChart.Axes(xlCategory).MajorUnit = 0.1
    ActiveChart.Axes(xlCategory).Crosses = xlAutomatic
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.ChartTitle.Select
    Selection.Delete
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.Axes(xlValue).Select
    Selection.Delete
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.Axes(xlCategory).Select
    Selection.Delete
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.Axes(1).MajorGridlines.Select
    Selection.Delete
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(51, 51, 51)
    End With
    ActiveChart.ChartArea.Select
    'Selection.Format.Line.EndArrowheadStyle = msoArrowheadTriangle
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.FullSeriesCollection(1).Points(2).Select
    Selection.MarkerStyle = -4142
    ActiveChart.FullSeriesCollection(1).Points(1).Select
    With Selection
        .MarkerStyle = 8
        .MarkerSize = 5
    End With
    Selection.MarkerSize = 6
    ActiveChart.ChartArea.Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    Application.CommandBars("Format Object").Visible = False
    ActiveSheet.Shapes(lNome).Fill.Visible = msoFalse
    
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.Axes(2).MajorGridlines.Select
    Selection.Delete
    
    
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.FullSeriesCollection(1).Points(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .Transparency = 0
        .Solid
    End With
    Selection.MarkerSize = 9
    ActiveChart.FullSeriesCollection(1).Points(2).Select
    'Selection.Format.Line.EndArrowheadStyle = msoArrowheadTriangle
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.ChartArea.Select
    With Selection.Format.Line
        .EndArrowheadLength = msoArrowheadLong
        .EndArrowheadWidth = msoArrowheadWide
    End With
    ActiveSheet.Shapes(lNome).ScaleWidth 0.6583333333, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes(lNome).ScaleHeight 0.7413192622, msoFalse, _
        msoScaleFromBottomRight
    ActiveSheet.Shapes(lNome).IncrementLeft 270.75
    ActiveSheet.Shapes(lNome).IncrementTop -72
    ActiveSheet.Shapes(lNome).ScaleWidth 1.0348101266, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes(lNome).ScaleHeight 1.3536308011, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes(lNome).IncrementLeft -50.25
    ActiveSheet.Shapes(lNome).IncrementTop 0.75
    
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.FullSeriesCollection(1).Points(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
    End With
    ActiveChart.ChartArea.Select
    Application.CommandBars("Format Object").Visible = False
    ActiveSheet.Shapes(lNome).Line.Visible = msoFalse
    Range("F10").Select
    
    ActiveSheet.Shapes(lNome).Select
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes(lNome).IncrementLeft -160.5
    ActiveSheet.Shapes(lNome).IncrementTop 11.25
    ActiveSheet.Shapes(lNome).ScaleWidth 0.8318042813, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes(lNome).ScaleHeight 0.8788924143, msoFalse, _
        msoScaleFromBottomRight
    ActiveSheet.Shapes(lNome).ScaleWidth 0.8161768566, msoFalse, _
        msoScaleFromBottomRight
    ActiveSheet.Shapes(lNome).ScaleHeight 0.8543307087, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes(lNome).IncrementLeft 1.5
    ActiveSheet.Shapes(lNome).IncrementTop 3
    Range("E2").Select
End Sub

Sub lsCriarGrafico()
    Dim lNomePlanilha As String
    Dim lGrafico1 As String
    Dim lGrafico2 As String
    
    lsCriarPlanilha lNomePlanilha
    lsTabelas
    lsGraficoRosca lNomePlanilha, lGrafico1
    lsPonteiro lNomePlanilha, lGrafico2
    lsAgrupar lGrafico1, lGrafico2
End Sub
Sub lsGraficoRosca(ByVal lNomePlanilha As String, ByRef lGrafico1 As String)
    Dim lNome As String
    
    Range("G1").Select
    
    ActiveSheet.Shapes.AddChart2(251, xlDoughnut).Select
    
    lNome = Replace(ActiveChart.Name, ActiveSheet.Name & " ", "")
    lGrafico1 = lNome
    
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Values = "=" & lNomePlanilha & "!$B$9:$B$14"
    ActiveChart.FullSeriesCollection(1).Values = "=" & lNomePlanilha & "!$B$9:$B$13"
    ActiveChart.FullSeriesCollection(1).XValues = "=" & lNomePlanilha & "!$A$9:$A$13"
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.ChartArea.Select
    ActiveChart.PlotArea.Select
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.ChartGroups(1).FirstSliceAngle = 90
    ActiveChart.ChartGroups(1).DoughnutHoleSize = 50
    ActiveChart.ChartArea.Select
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.ChartGroups(1).FirstSliceAngle = 90
    ActiveChart.FullSeriesCollection(1).Points(1).Select
    ActiveChart.ChartGroups(1).FirstSliceAngle = 90
    Selection.Format.Fill.Visible = msoFalse
    ActiveChart.ChartGroups(1).FirstSliceAngle = 90
    ActiveChart.Legend.Select
    Selection.Delete
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.ChartTitle.Select
    Selection.Delete
    ActiveSheet.ChartObjects(lNome).Activate
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.ChartGroups(1).FirstSliceAngle = 90
    ActiveChart.FullSeriesCollection(1).ApplyDataLabels
    ActiveChart.ChartGroups(1).FirstSliceAngle = 90
    ActiveChart.FullSeriesCollection(1).DataLabels.Select
    Selection.ShowCategoryName = True
    Selection.ShowValue = False
    ActiveChart.ChartArea.Select
    Range("J7").Select
End Sub

Sub lsCriarPlanilha(ByRef lNomePlanilha As String)
    Sheets.Add
    ActiveSheet.Name = "Velocimetro" & Sheets.Count
    lNomePlanilha = "Velocimetro" & Sheets.Count
End Sub

Sub lsAgrupar(ByVal lGrafico1 As String, ByVal lGrafico2 As String)
    ActiveSheet.ChartObjects(lGrafico1).Activate
    ActiveSheet.Shapes.Range(Array("Chart 1", "Chart 2")).Select
    Selection.ShapeRange.Group.Select
    Range("P14").Select
End Sub

Para criar o gráfico vá na guia Desenvolvedor -> Macros e escolha a macro Personal.XLSB!lsCriarGrafico e clique em Executar.

O código irá criar uma nova planilha e criar um novo gráfico de velocímetro.

No botão de download deste artigo você pode baixar um exemplo que cria estes gráficos ao pressionar o botão.

O resultado que temos então é a criação automática do velocímetro quando executa esta macro.

Criando então a tabela com os dados que precisa e também com o gráfico criado automaticamente com base nestes dados.

velocimetro excel 2

A tabela acima tem então a estrutura do gráfico para que possa ser criado o gráfico de velocímetro.

velocimetro excel 1

Após criado, pode copiar a sua tabela e o gráfico e colocar em outra planilha, ou copiar e colar a estrutura e criar novos gráficos.

O valor que precisa ser alterado para mudar o ponteiro do gráfico é o campo Resultado, nele você terá então a mudança da agulha conforme as categorias Ruim, Regular, Bom e Ótimo.

Se quiser também pode mudar as amplitudes conforme deseja ou mudar os nomes das categorias do gráfico.

O gráfico pode também ser alterado conforme desejar para mudar as cores ou distâncias e largura do gráfico.

Download Planilha Velocímetro VBA

Clique no botão abaixo para realizar o  download do arquivo de exemplo:

Download — baixe aqui: Velocímetro VBA

Preencha seus dados para receber o link de download no seu e-mail.

Principais recursos

Confira o que este material oferece para você.

Organização por data e etapas
Classificação automática
Ranking e destaques
Fluxos e etapas automáticas
Dashboard com indicadores
Atualização automática por fórmulas

Perguntas frequentes

O material é realmente gratuito?

Sim. O acesso é gratuito e não exige cadastro.

Preciso ter o Excel instalado?

Recomendamos o Excel 2013 ou superior para todos os recursos.

Como faço para receber atualizações?

As atualizações são automáticas dentro da própria planilha.

Funciona no Excel do Mac?

Sim, funciona no Excel para Windows e para Mac.

Funciona no celular?

É possível visualizar no app do Excel; a edição completa é no computador.

Planilhas relacionadas

Planilha de Fluxo de Caixa

Planilha de Fluxo de Caixa

(1.327)

R$ 89,90

Controle de Estoque

Controle de Estoque

(962)

R$ 69,90

Planilha Financeira Empresarial

Planilha Financeira Empresarial

(1.254)

R$ 79,90

Dashboard Financeiro no Excel

Dashboard Financeiro no Excel

(689)

R$ 49,90

Continue lendo

Curso Excel Master — Básico ao Avançado, VBA, PowerPoint e mais

Receba conteúdos e novidades direto no seu e-mail

Dicas, tutoriais, planilhas gratuitas e muito mais.

Não enviamos spam. Cancele quando quiser.

Download imediato

Acesso na hora após a compra

Compra 100% segura

Seus dados protegidos com SSL

Acesso vitalício

Use para sempre, sem mensalidades

Suporte via WhatsApp

Atendimento rápido e humanizado