Visual Basic Como fazer soma em listview

Eliéser Barbosa · 14 de maio de 2020

Gostaria que me ajudassem como fazer o codigo para somar os itens selecionados de forma que a soma dos valores fosse para um listbox ou textbox, pois quero gravar o nome da pessoa e o valor da soma dos exames em outra planilha onde depois eu vou fazer um relatorio mensal de quanto foi gasto.

pensei se desse pra fazer a selecao dos itens conforme a imagem abaixo . mas nao consigo sair daqui.

meu codigo ta uma bagunca que nem eu me acho mais o que realmente ta funcionando ou nao.

o codigo vai abaixo:

Option Explicit

Private Sub UserForm_Initialize()
Call Tags
'Call CarItens
'Call SomarItens
'Call CarItSoma

End Sub

Private Sub Tags()

    With ListView1
    
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        .MultiSelect = True
    
        .ColumnHeaders.Add Text:="SIGLA", Width:=85, Alignment:=0
        .ColumnHeaders.Add Text:="NOME", Width:=350, Alignment:=0
        .ColumnHeaders.Add Text:="VALOR", Width:=70, Alignment:=2
        
    End With
End Sub

Private Sub CarItSoma()

    Dim lin As Integer
    Dim li As Variant
    
    
    
    ListView1.ListItems.Clear
        
    Sheets("EXAMES").Select
    lin = 5
        
        Do Until Sheets("EXAMES").Cells(lin, 2) = ""
        
            Set li = ListView1.ListItems.Add(Text:=Sheets("EXAMES").Cells(lin, 2).Value)
            li.ListSubItems.Add Text:=Sheets("EXAMES").Cells(lin, 3).Value
            li.ListSubItems.Add Text:=Sheets("EXAMES").Cells(lin, 4).Value
                    
        lin = lin + 1
        
    Loop
    
    Dim Soma As Double
    
    For i = 1 To ListView1.ListItems.Count
    Soma = Soma + ListView1.ListItems.Item(i).SubItems(2)
    Next i
    
    TextSoma = Soma

End Sub

Private Sub CarItens()

    Dim linha, linhalist As Integer
    Dim Ultimalinha, Lista As Variant

        linhalist = 0
        linha = 5

        ListView1.ListItems.Clear

        Plan3.Select
        
        With Plan3
                
            While Cells(linha, 2).Value <> ""
        
            Ultimalinha = .Cells(Rows.Count, "b").End(xlUp).Row
                       
            
        With ListView1
            Set Lista = ListView1.ListItems.Add(Text:=Cells(linha, "b").Value)
            
                Lista.ListSubItems.Add Text:=Cells(linha, "c").Value
                Lista.ListSubItems.Add Text:=Cells(linha, "d").Value
    
        End With
        
        linhalist = linhalist + 1
        linha = linha + 1
    
        Wend
        End With
            
End Sub
    
Sub SomarItens()                                                                        'Soma itens selecionados no formulario

    Dim Linhas As Integer
    Dim Soma As Double

        With Form_lab
        
            Linhas = .ListView1.ListItems.Count
            
            For i = 5 To Linhas
            
                If .ListView1.ListItems(i).Selected = True Then
                    Soma = Soma + .ListView1.ListItems(i).ListSubItems(2)     'Valor
                End If
                            
            Next
                                                
            .lblSoma.Caption = Format(Soma, "Currency")
            
            'TextSoma.Value = ListView1.ListItems(lin).SubItems(2)
           
        End With
            
End Sub

Private Sub BtnLabPesqPact_Click()                                              'Abre o formulario de pesquisa dde pacientes.
Unload Form_lab
form_pesq.Show
End Sub

Basole · 14 de maio de 2020

Disponibilize o arquivo ou um exemplo proximo para entender melhor sua demanda

Eliéser Barbosa · 14 de maio de 2020

O programa já é funcional para pesquisar o nome dos pacientes e numero de prontuario.

Eu agora to ampliando ele para tb ser usado na marcacao de exames de laboratorio, mas o convenio libera ate R$2500/mes gratuito, na soma do total de exames marcados no mes vigente. Acima deste valor, qualquer exame para qualquer paciente tem custo normal. (logo apenas poucos pcts conseguem gratuidade).

Pra servir para as necessidades da empresa, preciso que no formulario de exames (form_lab) dê para selecionar os exames que serao agendados, faca-se a soma destes e no fim eu consiga salvar o nome do paciente e o custo total de exames na planilha "Relatorio" . Desta planilha retornar o valor do mes corrente numa label no formulario, sempre que este for carregado, avisando que o limite ja foi ou nao atingido (por exemplo a soma total do mes fica em vermelho quando for ≥2500 (este valor é atualizado anualmente)). E no fim ainda estou preocupado que tanta informcao em um unico arquivo possa apresentar problemas. Por isso pensei em criar uma rotina que salva os valores num novo arquivo automaticamente a cada dia 1º com o seguinte nome "Exames_MAI2020", "Exames_JUN2020", etc,"(Referente aos exames marcados do dia 01 ao 31), sendo que depois que salva ele limparia a aba "Relatorio" para o registro do mes seguinte.

Se desse para salvar como expliquei acima a ideia era inclusive add nese relatorio o nome ou sigla dos exames que foram feitos.

Costumo deixar as macros salvas em C:/Macros e selecionei esta pasta como local confiavel. Gostaria de salvar os arquivos em uma subpasta, para separa o Bckup do cadastro de pacientes(CopySeg_PACIENTES - m_aaaa) do bckup "Exames_MMMaaaa".

OBS: Ainda estou aprendendo muita coisa, mas a necessidade o servico é grande. Comecei a fazer um pequeno curso de programacao pra comecar a entender isso tudo. mas so fazem 2 dias que comecei. Todos os meus codigos foram exemplos da internet que tentei adptar para a minha necessidade. Nao encontrei na inernet muito material relacionado ao que quero fazer, tem alguma coisa mas ficou muito consfuso pra mim porque nao conheco os fundamentos pra fazer mudanca nos codigos mais avancadas do que mudar nome de planilha e celulas. Por isso preciso de ajuda. Muito obrigado.

Cad_Paciente_v2.1.rar

Eliéser Barbosa · 21 de maio de 2020

Em 14/05/2020 às 14:32, Eliéser Barbosa disse:

O programa já é funcional para pesquisar o nome dos pacientes e numero de prontuario.

Eu agora to ampliando ele para tb ser usado na marcacao de exames de laboratorio, mas o convenio libera ate R$2500/mes gratuito, na soma do total de exames marcados no mes vigente. Acima deste valor, qualquer exame para qualquer paciente tem custo normal. (logo apenas poucos pcts conseguem gratuidade).

Pra servir para as necessidades da empresa, preciso que no formulario de exames (form_lab) dê para selecionar os exames que serao agendados, faca-se a soma destes e no fim eu consiga salvar o nome do paciente e o custo total de exames na planilha "Relatorio" . Desta planilha retornar o valor do mes corrente numa label no formulario, sempre que este for carregado, avisando que o limite ja foi ou nao atingido (por exemplo a soma total do mes fica em vermelho quando for ≥2500 (este valor é atualizado anualmente)). E no fim ainda estou preocupado que tanta informcao em um unico arquivo possa apresentar problemas. Por isso pensei em criar uma rotina que salva os valores num novo arquivo automaticamente a cada dia 1º com o seguinte nome "Exames_MAI2020", "Exames_JUN2020", etc,"(Referente aos exames marcados do dia 01 ao 31), sendo que depois que salva ele limparia a aba "Relatorio" para o registro do mes seguinte.

Se desse para salvar como expliquei acima a ideia era inclusive add nese relatorio o nome ou sigla dos exames que foram feitos.

Costumo deixar as macros salvas em C:/Macros e selecionei esta pasta como local confiavel. Gostaria de salvar os arquivos em uma subpasta, para separa o Bckup do cadastro de pacientes(CopySeg_PACIENTES - m_aaaa) do bckup "Exames_MMMaaaa".

OBS: Ainda estou aprendendo muita coisa, mas a necessidade o servico é grande. Comecei a fazer um pequeno curso de programacao pra comecar a entender isso tudo. mas so fazem 2 dias que comecei. Todos os meus codigos foram exemplos da internet que tentei adptar para a minha necessidade. Nao encontrei na inernet muito material relacionado ao que quero fazer, tem alguma coisa mas ficou muito consfuso pra mim porque nao conheco os fundamentos pra fazer mudanca nos codigos mais avancadas do que mudar nome de planilha e celulas. Por isso preciso de ajuda. Muito obrigado.

Cad_Paciente_v2.1.rar 252.35 kB · 0 downloads

adicionado 3 minutos depois

Gostaria de saber se falta alguma informacao que deva ser relevante para alguem poder me ajudar? qualquer resposta ja ajuda, nao pretendo deixar o topico morrer sem uma resposta, mesmo que seja uma resposta dizendo que nao tem como ajudar. Teria colocado esta duvida em programacao para inicianes mas entendi que quem mechem com VBA supostamente não é iniciante em programacao.

Midori · 22 de maio de 2020

Em 13/05/2020 às 21:28, Eliéser Barbosa disse:

Gostaria que me ajudassem como fazer o codigo para somar os itens selecionados de forma que a soma dos valores fosse para um listbox ou textbox

No For da Sub SomarItens coloque para iniciar em 1,

For i = 1 To Linhas

Assim a soma será calculada corretamente.

E no ListviewClik, você pode fazer algo assim para não ficar carregando a cada clique,

Private Sub ListView1_Click()
    Static B   As Boolean
    
    If B = False Then CarItens

    B = True

    Call SomarItens
End Sub

Eliéser Barbosa · 27 de maio de 2020

Quero agradescer a ajuda. serviu ao meu proposito sim, mas percebi um problema. parece q ta tendo um glicth, em que quando carrega a listview o primeiro item da lista ja fica selecionado, preciso clicar na lista para ela atualizar e zerar completamente. existe um call somar itens no userform_initialize, sera que pode ser isso?

tenho mais outras duas duvidas sobre codigo do projeto, gostaria de saber dos mods se abro um novo topico ou continuo com esse?

Eliéser Da Silva Barbosa · 10 de junho de 2020

Como ainda faz parte do mesmo formulario to agora com um problema no codigo. Preciso fazer duas coisas:

1-No Codigo16 a linha "ListInput.AddItem Cells(a, 2)" que vem logo após ao "Then" dentro do "If" diz que precisa ser depurada e nao sei como resolver. Esse codigo faz a entrada de dados "nome " da Plan4 (sheet PACIENTES) no listinput. Na verdade preciso de um codigo de texto autocomplete que nao demore a carregar, mas que ao mesmo tempo permita que eu visualize enquanto digito quais os nomes de paciente que vão correspondendo conforme o que esta sendo digitado (seria melhor que quando ao clicar em cima da opcao com o ponteiro do mouse ela termine de preencher o campo). Também necessito apagar o nome enquanto escrevo e mesmo depois de escrito usando apenas o Backspace(Parece o a funcao backspace no codigo nao funciona???). Neste caso usei uma TextBox para escrever e uma ListBox para visualizar. Mas se tiverem outra ideia estou aberto a sugestoes.

2-To achando que no meu codigo tem funcoes que nao estão sendo usadas e só esao gerando conflito, mas nao sei detectar. Alguem pode dar uma ajuda nisso?

O objetivo deste formulario é criar uma agenda de marcacao de exames laboratoriais e lanca-los na planilha para depois resgatar estes dados para imprimir e/ou visualizar o relatorio em pdf, que vai ser outro problema que terei que resolver. Pois como nao sei fazer de outra forma adicionei virgulas após o nome de cada exame na planilha (o que deixa na listview visualmente desagradavel), mas pelo menos assim é lancado de alguma forma eu possa dividir as palavras epois e lanca-las como exames de forma individual.

Option Explicit
'Digite aqui o intervalo a ser autocompletado
Private Const r As String = "B1:B1000000"
Private sInput As String

Dim NomePct As Range
Dim flParar As Boolean                                                      'Faz parar a pesquisa dos dados digitados

'Código1
Private Sub BtnSavSelec_Click()                                             'Grava o nome e a soma dos exames na planilha MARCACAO

    Dim Nome As String
    Dim Lab As String
    Dim SomaI As Double
    Dim Linha As Variant
    Dim dia As String, mes As String, ano As String, Agenda As String
        
    dia = Calendario1.Day
    mes = Calendario1.Month
    ano = Calendario1.Year
    Agenda = DateValue(dia & "/" & mes & "/" & ano)
        
    Linha = 2
    Nome = txtInput
    SomaI = TextSoma
    Lab = TextLab
    
    While Plan5.Cells(Linha, 1).Value <> ""
    Linha = Linha + 1
    Wend
    
        Plan5.Cells(Linha, 1).Value = Nome
        Plan5.Cells(Linha, 2).Value = SomaI + Linha
        Plan5.Cells(Linha, 3).Value = Lab
        Plan5.Cells(Linha, 4).Value = Agenda
        
        MsgBox "Cadastrado com sucesso...", 64, "Dados"
        Me.txtInput = ""
        Me.TextSoma = ""
        Me.TextLab = ""
     Call CustoM
          
End Sub

'Código2
Private Sub ListView1_Click()                                                   'Impede a Listview de ficar carregando a cada clique
    
    Static B   As Boolean, C As Boolean
        
        If B = False Then CarItens
        B = True
        
        'ElseIf C = False Then AddLab
        'C = True
        'End If
        Call SomarItens
        Call AddLab
        
        
End Sub

'Código3
Private Sub BtnLabPesqPact_Click()                                              'Abre o formulario de pesquisa dde pacientes.
Unload Form_lab
form_pesq.Show
End Sub

'Código4
Private Sub txtInput_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)  'Ao digitar deletar ou backspace o sistema limpa a variável de controle para pesquisar novamente

    'Limpa a variável de controle
    If (KeyCode = vbKeyBack) Or (KeyCode = vbKeyDelete) Then
        flParar = True
    Else
        flParar = False
    End If
        
    If (KeyCode = 13) Then
        ActiveCell.Value = Form_lab.txtInput.Text
        Form_lab.txtInput.Value = vbNullString
        Form_lab.Hide
    End If
 
End Sub

'Código5
Private Sub txtInput_Change()                                                   'Faz a busca dos nomes

Dim Texto As String
Dim Pesquisa As String

ListInput.Visible = True

Pesquisa = txtInput.Text
NomePct.Value = txtInput.Value

Texto = NomePct.AutoComplete(txtInput.Text)

If Len(Texto) > 0 Then
With txtInput
    .Text = Texto
    .SelStart = Len(Pesquisa)
    .SelLength = Len(Texto)
    
End With

End If

Call LstInpView

End Sub

'Codigo6
Private Sub txtInput_Enter()
Set NomePct = Sheets("PACIENTES").Range("B1048576").End(xlUp).Offset(1, 0)
End Sub

'Codigo7
Private Sub txtInput_Exit(ByVal Cancel As MSForms.ReturnBoolean)
NomePct.ClearContents
End Sub

'Codigo8
Private Sub txtInput_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)          'Faz com que ao digitar todas as letras fiquem em maiusculas, permita apagar usando backsspace e emula a funçao da tecla TAB* (*Eu acho que faz a funcao TAB pelo menos)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
Select Case KeyAscii
      Case 8       'Aceita o BACK SPACE
      Case 13: SendKeys "{TAB}"    'Emula o TAB
End Select
End Sub

'Codigo9
Private Sub form_lab_Click()                                                    'Permite que apareca a listInput somente quando comecar a digitar algo na txtInput
ListInput.Visible = False
End Sub

'Codigo10
Private Sub UserForm_Initialize()
    Call Tags                                                                   'Cria tags identificando cada coluna
    Call CarItens                                                               'Carrega o listview com os dados da planilha EXAMES
    Call SomarItens                                                             'Realiza a soma dos itens selecionados no formulario
    Call CustoM                                                                 'Apresenta a soma dos exames marcados no mes corrente
        
End Sub

'Codigo11
Private Sub Tags()                                                              'Cria tags para as colinas da listview

    With ListView1
    
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        .MultiSelect = True
    
        .ColumnHeaders.Add Text:="SIGLA", Width:=75, Alignment:=0
        .ColumnHeaders.Add Text:="NOME", Width:=530, Alignment:=0
        .ColumnHeaders.Add Text:="VALOR", Width:=75, Alignment:=0
        
    End With
End Sub

'Codigo12
Private Sub CarItens()                                                           'Carrega os itens na listview

    Dim Linha, linhalist As Integer
    Dim Ultimalinha, Lista As Variant

        linhalist = 0
        Linha = 2

        ListView1.ListItems.Clear

        Plan3.Select
        
        With Plan3
                
            While Cells(Linha, 1).Value <> ""
        
            Ultimalinha = .Cells(Rows.Count, "a").End(xlUp).Row
                       
            
        With ListView1
            Set Lista = ListView1.ListItems.Add(Text:=Cells(Linha, "a").Value)
            
                Lista.ListSubItems.Add Text:=Cells(Linha, "b").Value
                Lista.ListSubItems.Add Text:=Format(Cells(Linha, "c").Value, "R$ #0.00")
    
        End With
        
        linhalist = linhalist + 1
        Linha = Linha + 1
    
        Wend
        End With
            
End Sub

'Codigo13
Private Sub SomarItens()                                                           'Soma itens selecionados no formulario

    Dim Linhas As Integer
    Dim Soma As Double
    Dim i As Variant
        With Form_lab
        
            Linhas = .ListView1.ListItems.Count
            
            For i = 2 To Linhas
            
                If .ListView1.ListItems(i).Selected = True Then
                    Soma = Soma + .ListView1.ListItems(i).ListSubItems(2)     'Valor
                End If
                            
            Next
                                                         
            TextSoma.Value = Format(Soma)
           
        End With
            
End Sub

'Codigo14
Private Sub CustoM()

Dim C As Double

C = TextSomaM
C = WorksheetFunction.Sum(Plan5.Range("B2:B200"))                                   'Faz a soma dos exames marcados no mes e lanca no textbox
TextSomaM.Value = Format(C, "Currency")                                             'Formata o textbox no formato Moeda
    
    If Me.TextSomaM.Text > 2500 Then                                                'Cria uma condicao trocando a cor da fonte para vermelho
        Me.TextSomaM.ForeColor = &HFF&
    End If
        
End Sub
'Codigo15
Private Sub AddLab()                                                                'Permite selecionar o nome dos exames na listbox e enviar para uma textbox que envia os dados para a planilha

Dim Carregar As Variant
Dim Lab As Variant
Dim Linhas As String


    With Form_lab
    
    Linhas = .ListView1.ListItems.Count
    
        For Carregar = 2 To Linhas
            
            If .ListView1.ListItems(Carregar).Selected = True Then
                Lab = Lab + .ListView1.ListItems(Carregar).ListSubItems(1)           'Nomes dos exames
            End If
            
         Next
         
         TextLab.Value = Lab
         
    End With
End Sub
'Codigo16
Private Sub LstInpView()                                                             'Colocar uma call em Private Sub txtInput_Change

    Dim a As Integer
    
    Plan4.Select
    ListInput.Clear
    ListInput.Visible = True
    
    For a = 1 To Range("B1000000").End(xlUp).Row
        If UCase(Left(Cells(a, 2), Len(txtInput.Text))) = UCase(txtInput.Text) Then
            ListInput.AddItem Cells(a, 2)
        End If
    Next a
    
End Sub

Cad_Paciente_v2.2.rar

Eliéser Da Silva Barbosa · 16 de junho de 2020

alguem poderia dar outra maozinha aq?

Midori · 16 de junho de 2020

Em 27/05/2020 às 19:03, Eliéser Barbosa disse:

Quero agradescer a ajuda. serviu ao meu proposito sim, mas percebi um problema. parece q ta tendo um glicth, em que quando carrega a listview o primeiro item da lista ja fica selecionado, preciso clicar na lista para ela atualizar e zerar completamente. existe um call somar itens no userform_initialize, sera que pode ser isso?

Para resolver atribua 0 ao label da soma no Initialize do Form,

lblSoma = 0

Sandro António · 10 de julho de 2023

Preciso que ajudem a exportar este dados da ListBox em arquivo Pdf o mais urgente possível, porque o código que uso não está a dar certo nesta planilha do excel

2 minutos atrás, Sandro António disse:

Preciso que ajudem a exportar este dados da ListBox em arquivo Pdf o mais urgente possível, porque o código que uso não está a dar certo nesta planilha do excel