ListView com Gráfico de Barras usando Excel VBA

Nesse post você aprenderá a criar um ListView com Gráfico de Barras usando técnicas avançadas do Excel VBA. O Projeto que iremos desenvolver é um Formulário de Meta vs Realizado em Vendas. A ideia é mostrar um gráfico de preenchimento com base na porcentagem total das vendas realizadas em relação à meta estabelecida pelo estabelecimento. Além disso, o ListView que iremos desenvolver possui campos editáveis dentro da coluna de Meta , para permitir mudar os valores sempre que necessário. Caso, tenha curiosidade em saber como tornar um Controle ListView editável, acesse o post Criando uma ListView Editável.

Antes de iniciar, faça download das imagens que serão usadas nesse projeto. Abra o Excel e acesse o ambiente de programação Visual Basic. Insira um userform e renomeie para ProdutosMetas. Defina como dimensões, 832 para largura e 574 para altura.

Salve o projeto dentro da mesma pasta onde estão as imagens dos ícones, dê o nome de ListView-Com-Graficos. Lembre-se de salvar o arquivo como Pasta de Trabalho Habilitada para Macro, ou seja, extensão .xlsm.

Em seguida insira um listview, renomeie para lvMetas e defina 762 de largura e 303 de altura. Insira também o controle ImageList. Caso tenha dificuldades e habilitar esses dois controles, veja o post ListView VBA – Uso e Aplicação do Controle ListView VBA, ensinado como fazer essa operação passo a passo.

Esse primeiro código carrega as imagens que serão usadas como ícones dos subitems, pinta o fundo de alguns controles como o userfom, listview e frame, além de criar os cabeçalhos das colunas. O código será executado ao inicializar o userfom.

Private Sub UserForm_Initialize()

On Error Resume Next

Dim fdCor       As Variant
Dim wbk         As Workbook

Set wbk = Workbooks("ListView-Com-Graficos.xlsm")

fdCor = RGB(8, 10, 28)

ProdutosMetas.BackColor = fdCor
lvMetas.BackColor = fdCor

With Me.ImageList1.ListImages

  .Add , "img1", LoadPicture(wbk.Path & "\icons\meta.jpg")
  .Add , "img2", LoadPicture(wbk.Path & "\icons\realizado.jpg")
  .Add , "img3", LoadPicture(wbk.Path & "\icons\sim.jpg")

End With

With lvMetas
    .ColumnHeaders.Clear
    .View = lvwReport
    .SmallIcons = ImageList1
    .FullRowSelect = False
    .FlatScrollBar = False
    .ColumnHeaders.Clear
    .ColumnHeaders.Add , , "Mes", 0
    .ColumnHeaders.Add , , "Mes", 75, 2
    .ColumnHeaders.Add , , "Meta", 140, 2
    .ColumnHeaders.Add , , "Realizado", 140, 2
    .ColumnHeaders.Add , , "% Realizado", 406, 2
    
End With

End Sub

Vamos agora inserir os dados que serão carregados para dentro do listview, e que, por consequência serão usados como critérios para inserção dos gráficos.

Agora, já podemos levar os dados para dentro do ListView. Para isso escrevemos a sub PreparaListView() abaixo, em seguida criamos um botão para chamar essa sub sempre que for dado um click sob o botão.

Sub PreparaListView()

Dim lvItem      As ListItem
Dim wPlan       As Worksheet
Dim lin         As Integer
Dim mtProd      As Double

lin = 2
Set wPlan = Planilha1

wPlan.Activate

With wPlan

        While Not .Cells(lin, 1) = ""
        
            mtProd = .Cells(lin, 2)
            
            Set lvItem = lvMetas.ListItems.Add(, , .Cells(lin, 1))
            
            lvItem.ListSubItems.Add , , Left(.Cells(lin, 1), 3)
            
            lvItem.ListSubItems.Add , , Format(mtProd, "0.00"), 1

            lvItem.ListSubItems.Add , , ""
            lvItem.ListSubItems.Add , , ""
            
            lin = lin + 1
            
        Wend
End With

End Sub

Ao executar o código, teremos a seguinte imagem.

Vamos agora trazer os dados de valores realizados para dentro do listview. Alem disso, devemos inserir dentro da última coluna os dados de porcentagem entre o realizado e a meta estabelecida inicialmente.

Sub BuscRealizado()

Dim lvItem      As ListItem
Dim wPlan       As Worksheet
Dim lin         As Integer
Dim mtProd      As Double
Dim vReal       As Double
Dim vFin        As Double
Dim m           As Integer

lin = 2
Set wPlan = Planilha1

wPlan.Activate

With wPlan

    For m = 1 To lvMetas.ListItems.Count

                mtProd = .Cells(lin, 2)
                vReal = .Cells(lin, 3)

                If mtProd = 0 Or vReal = 0 Then
                    vFin = 0
                Else
                    vFin = vReal / mtProd
                End If
                
                If vReal > mtProd Then
                    lvMetas.ListItems(m).ListSubItems(1).ReportIcon = 3
                Else
                End If
                
                If vReal = 0 Then
                    lvMetas.ListItems(m).ListSubItems(3).Text = "0,00"
                Else
                    lvMetas.ListItems(m).ListSubItems(3).Text = Format(vReal, "R$ ####,##0.00")
                    lvMetas.ListItems(m).ListSubItems(3).ReportIcon = 2
                End If

                If mtProd = 0 Or vReal = 0 Then
                    lvMetas.ListItems(m).ListSubItems(4).Text = "0,00"
                Else
                    lvMetas.ListItems(m).ListSubItems(4).Text = Format(vFin, "0.00%")
                End If
            
            mtProd = 0
            vReal = 0
            lin = lin + 1
    Next m

End With

End Sub

Ao executar o código, teremos então a seguinte imagem. Note que na primeira coluna temos um destaque dos meses onde a meta foi alcançada, e na última coluna temos a porcentagem de realização dessa meta.

Iremos agora inserir, uma coluna editável dentro do nosso listview. O objetivo é poder mudar os valores de meta sempre nos for conveniente. Para isso, iremos os próximos dois código abaixo.

Sub CampoMetaEditavel()

Dim fdCor       As Variant
Dim i           As Integer
Dim frameMeta   As MSForms.control

fdCor = RGB(8, 10, 28)

For i = 1 To lvMetas.ListItems.Count
    
    Set frameMeta = ProdutosMetas.Controls.Add("Forms.Frame.1", Name:="Frame" & i)
    
    With frameMeta
    
        .Top = lvMetas.ListItems(i).Top + lvMetas.Top + 2
        .Left = lvMetas.ColumnHeaders(3).Left + lvMetas.Left + 27
        .Width = lvMetas.ColumnHeaders(3).Width - 50
        .Height = lvMetas.ListItems(i).Height - 2
        .Caption = ""
        .ZOrder msoBringToFront
        .BackColor = fdCor
        .BorderColor = fdCor
        .BorderStyle = 1
        
    End With
        
Next i

Set frameMeta = Nothing

End Sub

Sub CriaTextBoxMeta()

Dim fdCor       As Variant
Dim verd        As Variant
Dim i           As Integer
Dim nText       As MSForms.control
Dim frameMeta   As MSForms.control

fdCor = RGB(8, 10, 28)
verd = RGB(22, 252, 175)

For i = 1 To lvMetas.ListItems.Count
    
    Set frameMeta = ProdutosMetas.Controls("Frame" & i)
    
    Set nText = frameMeta.Add("Forms.Textbox.1", Name:="TxtBx" & i)
    
    With nText
        .Text = lvMetas.ListItems(i).SubItems(2)
        .Left = 0
        .Width = frameMeta.Width
        .TextAlign = fmTextAlignCenter
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &H404040
        .Height = frameMeta.Height
        .Font.Size = 11
        .BackColor = verd
        .ForeColor = rgbBlack

    End With
    
Next

Set frameMeta = Nothing
Set nText = Nothing

End Sub

Perceba que agora os subitems da coluna meta possuem campos editáveis, onde podemos estar inserindo valores de meta desejados para cada mês do ano.

O próximo passo é inserir os gráficos de barras dentro da nossa última coluna do listview. O procedimento é similar ao que acabamos de realizar, a exceção de que no lugar da textbox, iremos inserir controles do tipo Label. Isso será feito através do uso dos quatro códigos abaixo.

Sub CampoGrafico()

Dim fdCor           As Variant
Dim i               As Integer
Dim frameGrafico    As MSForms.control


fdCor = RGB(8, 10, 28)

For i = 1 To lvMetas.ListItems.Count

    Set frameGrafico = ProdutosMetas.Controls.Add("Forms.Frame.1", Name:="Fram" & i)
    
    With frameGrafico

        .Top = lvMetas.ListItems(i).Top + lvMetas.Top
        .Left = lvMetas.ColumnHeaders(5).Left + lvMetas.Left
        .Width = lvMetas.ColumnHeaders(5).Width
        .Height = lvMetas.ListItems(i).Height
        .Caption = ""
        .ZOrder msoBringToFront
        .BackColor = fdCor
        .BorderColor = fdCor
        .BorderStyle = 1
        
    End With
Next i

Set frameGrafico = Nothing

End Sub

Sub InserePorcentagem()

Dim frameGrafico    As MSForms.control
Dim PorcentTxt      As MSForms.control
Dim i               As Integer
Dim fdCor           As Variant

fdCor = RGB(8, 10, 28)

For i = 1 To lvMetas.ListItems.Count
    
    Set frameGrafico = ProdutosMetas.Controls("Fram" & i)
    Set PorcentTxt = frameGrafico.Add("Forms.Textbox.1", Name:="Textbox" & i)

    With PorcentTxt
        .Text = lvMetas.ListItems(i).SubItems(4)
        .Left = 0
        .Top = 1
        .Width = 70
        .TextAlign = fmTextAlignRight
        .BorderStyle = 1
        .BorderColor = fdCor
        .Height = lvMetas.ListItems(i).Height
        .Font.Size = 12
        .BackColor = fdCor
        .ForeColor = rgbWhite
    End With
    
Next i

Set frameGrafico = Nothing
Set PorcentTxt = Nothing

End Sub

Sub CriaBarraComContorno()

Dim frameGrafico    As MSForms.control
Dim barraTrasp      As MSForms.control
Dim i               As Integer
Dim fdCor           As Variant

fdCor = RGB(8, 10, 28)

For i = 1 To lvMetas.ListItems.Count
    
    Set frameGrafico = ProdutosMetas.Controls("Fram" & i)
    Set barraTrasp = frameGrafico.Add("Forms.Label.1")
    
    With barraTrasp
        .Name = "Label" & i
        .Top = 5
        .Height = 13.25
        .Width = 320
        .BackColor = rgbWhite
        .Left = 75
        .Caption = ""
        .BackStyle = 0 'fmBackStyleTransparent
        .BorderStyle = 1
        .BorderColor = &H404040
    End With
Next i

Set frameGrafico = Nothing
Set barraTrasp = Nothing
    
End Sub

Sub CriaBarra()

Dim fdCor           As Variant
Dim cVerd           As Variant
Dim frameGrafico    As MSForms.control
Dim barra           As MSForms.control
Dim i               As Integer
Dim vFin            As Double

cVerd = RGB(3, 239, 14)
fdCor = RGB(8, 10, 28)

For i = 1 To lvMetas.ListItems.Count
    
    Set frameGrafico = ProdutosMetas.Controls("Fram" & i)
    Set barra = frameGrafico.Add("Forms.Label.1")
    
    vFin = Format(lvMetas.ListItems(i).SubItems(4), "0.00")

    With barra
        .Name = "Lab" & i
        .Top = 5
        .Height = 13.25
        .Left = 75
        .Caption = ""
        .BorderStyle = 1
        .BorderColor = &H404040
        .ZOrder msoSendToBack

        .Width = (320 * vFin)

        .BackColor = cVerd

    End With

Next i

Set frameGrafico = Nothing
Set barra = Nothing

End Sub

Note que o ListView com Gráfico de Barras já está criado, só precisamos agora realizar alguns ajustes para correção de alguns alguns pequenos problemas. Para isso, iremos criar alguns critérios, e então, ter ListView com Gráfico de Barras robusto e funcional.

Vamos agora criar um gráfico de barras geral, levando em consideração a soma de todos valores de meta e de todos os valores realizados, seria então um gráfico de meta vs realizado de todo o ano. Para isso, iremos criar um frame, e dentro desse frame, inserir três textboxes. Em seguida, inserimos dois controles do tipo Label, uma com fundo transparente e outra de fundo opaco para preenchimento, conforme foi feito para nossa listview de metas mensais. Além disso, escrevemos os seguinte código, que somará todos os valores tanto de meta quanto de realizado.

Sub SomaValores()

    Dim MtVVendas     As Double
    Dim RlVVendas     As Double
    Dim pctServ     As Double
    Dim vGrafSer    As Double
    
    Dim cVerd       As Variant
    Dim cAmar       As Variant
    Dim cLarg       As Variant
    Dim cVerm       As Variant
    
    cVerd = RGB(3, 239, 14)
    cAmar = RGB(255, 255, 0)
    cLarg = RGB(234, 107, 20)
    cVerm = RGB(255, 0, 0)
    '------------>>>>>>>>>>>>>>>>
    Dim i               As Integer
    
    For i = 1 To lvMetas.ListItems.Count
    
        MtVVendas = MtVVendas + lvMetas.ListItems(i).SubItems(2)
        RlVVendas = RlVVendas + lvMetas.ListItems(i).SubItems(3)
        
    Next i
    
    txtMtVendas.Value = Format(MtVVendas, "R$ ####,##0.00")
    txtRealizado.Value = Format(RlVVendas, "R$ ####,##0.00")
    txtPcVendas.Value = Format(RlVVendas / MtVVendas, "0.00%")
    
    If MtVVendas = 0 Or RlVVendas = 0 Then
        lblCalVendas.Width = 0
    ElseIf RlVVendas > MtVVendas Then
        lblCalVendas.Width = 750
    Else
        lblCalVendas.Width = (750 * (RlVVendas / MtVVendas))
    End If
    '-------------------------------------------
    vGrafSer = lblCalVendas.Width
    
    If RlVVendas > MtVVendas Then
        lblCalVendas.BackColor = cVerd
    ElseIf vGrafSer < 750 And vGrafSer >= 487 Then
        lblCalVendas.BackColor = cAmar
    ElseIf vGrafSer < 487 And vGrafSer >= 262 Then
        lblCalVendas.BackColor = cLarg
    Else
        lblCalVendas.BackColor = cVerm
    End If
    
End Sub

Ao chamar o código abaixo dentro do evento click do nosso botão Carrega dados, nosso UserForm final, ficará da seguinte forma.

Experimente clicar do botão Carregar dados duas vezes. Temos aqui uma questão ser solucionada, pois ele não insere os dados corretamente depois do primeiro click. Para solucionar isso, iremos criar uma sub para limpar os dados antes de começar a criar os os controles dinâmicos dos gráficos de barras e dos demais. Para isso, experimente colar o código abaixo no inicio do evento click do botão carregar dados.

Sub limpaTudo()

Dim corf As Control

lvMetas.ListItems.Clear

For Each corf In ProdutosMetas.Controls
    If TypeName(corf) = "Frame" And Left(corf.Name, 5) = "Frame" Then
        Me.Controls.Remove corf.Name
    End If
Next corf


Set corf = Nothing

For Each corf In ProdutosMetas.Controls
    If TypeName(corf) = "Frame" And Left(corf.Name, 4) = "Fram" Then
        Me.Controls.Remove corf.Name
    End If
Next corf
Set corf = Nothing

txtRealizado.Value = ""
txtPcVendas.Value = ""
txtMtVendas.Value = ""

End Sub

Vamos agora, salvar os dados dos subitens da coluna editável meta. Para isso, criamos um botão e damos o nome de SalvaBt.

Private Sub SalvaBt_Click()

Dim wPlan       As Worksheet
Dim n           As Integer
Dim vMeta       As Double
Dim lin         As Integer

Set wPlan = Planilha1

lin = 2

wPlan.Activate

With wPlan

    For n = 1 To lvMetas.ListItems.Count
    
        If Controls("TxtBx" & n).Text = "" Or Controls("TxtBx" & n).Text = 0 Then
            vMeta = 0
        Else
            vMeta = Controls("TxtBx" & n).Text
        End If

            .Cells(lin, 2) = vMeta
            
        lin = lin + 1
        
    Next n

End With

MsgBox "Dados salvos com sucesso", vbInformation + vbOKOnly, "Finalizado com sucesso"

End Sub

Para evitar que se digite valores de texto dentro dos subitens editáveis da nossa coluna meta, iremos classe com o nome mKeyPress e chamar essa classe para cada um dos nossos subitens editáveis do nosso controle listview. Precisaremos aqui de dois códigos, o código da criação da classe, e o código para rodar no momento em que o controles dinâmicos forem criados.

Option Explicit

Public WithEvents eventoTb As MSForms.TextBox

Private Sub eventoTb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 44 Then
    KeyAscii = 0
End If

End Sub

For Each cntObjeto In Me.Controls
    If TypeOf cntObjeto Is MSForms.TextBox Then
        p = p + 1
        ReDim Preserve verTb(1 To p)
        Set verTb(p).eventoTb = cntObjeto
    End If
Next cntObjeto

Set cntObjeto = Nothing