Este fórum está sendo desativado

[Eduardo15]

Boa tarde Pessoal!

Me ajudem...

No Textbox eu digito: a palavra carro. Então no Listview vai aparecer tudo referente a Carro que existe no cadastro, conforme abaixo.

teste 1
carro 2
pedra 3
carro 4

Então no label abaixo o Resultado será 02 palavras referente a carro encontrados e na soma 06.

Label " lblMensagens.Caption = 02 registros encontrados
Label " LabelSomaRegistros = 06

Se apagar a palavra carro do textbox então o resultado será:

Label " lblMensagens.Caption = 04 registros encontrados
Label " LabelSomaRegistros = 10

O Label lblMensagens está funcionando perfeitamente, só o Label " LabelSomaRegistros que não...
ele só mostra a soma total de todos os registros, mas o que preciso é ao digitar uma palavra ele dar a SOMA dos valores corresponde a palavra digitada no Textbox....

Segue código abaixo:

Código: Selecionar todos

Private Sub PopulaListBox(ByVal NomeEmpresa As String)


Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False


    On Error GoTo TrataErro

    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sql As String
    Dim sqlWhere As String
    Dim sqlOrderBy As String
    Dim i As Integer
    Dim campo As Field
    Dim myArray() As Variant

    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.JET.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
        .Open
    End With

    sql = "SELECT * FROM [REGISTRO$]"

    'monta a cláusula WHERE
    'NomeDaEmpresa
    Call MontaClausulaWhere(txtNomeEmpresa.Name, "Objetivos", sqlWhere)
    Call MontaClausulaWhere(Me.Txt_PESQNOME.Name, "Nome", sqlWhere)
    Call MontaClausulaWhere(Me.txtNomeCOMPANY.Name, "Empresa", sqlWhere)
      Call MontaClausulaWhere(Me.Text_pesqdata.Name, "Data", sqlWhere)
     Call MontaClausulaWhere(Me.Text_pesqmatricula.Name, "Registro", sqlWhere)
     Call MontaClausulaWhere(Me.TextBoxCARGO.Name, "Cargo", sqlWhere)
    
    'faz a união da string SQL com a cláusula WHERE
    If sqlWhere <> vbNullString Then
        sql = sql & " WHERE " & sqlWhere
    End If

    'faz a união da string SQL com a cláusula ORDER BY
   

    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open sql, conn, adOpenDynamic, _
              adLockBatchOptimistic
    End With

    'pega o número de registros para atribuí-lo ao listbox
    lstLista.ColumnCount = rst.Fields.Count

    'preenche o combobox com os nomes dos campos
    'persiste o índice
    Dim indiceTemp As Long
    
    
    'recupera o índice selecionado


    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.EOF And Not rst.BOF Then
        myArray = rst.GetRows
        'troca linhas por colunas no Array
        myArray = Array2DTranspose(myArray)
        'atribui o Array ao listbox
        lstLista.List = myArray
        'adiciona a linha de cabeçalho da coluna
        lstLista.AddItem , 0
        'preenche o cabeçalho
        For i = 0 To rst.Fields.Count - 1
            lstLista.List(0, i) = rst.Fields(i).Name
        Next i
        'seleciona o primeiro item da lista
        lstLista.ListIndex = 0
    Else
        lstLista.Clear
    End If

    'atualiza o label de mensagens
    If lstLista.ListCount <= 0 Then
        lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
    Else
        lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
    End If
    
    
    
    Dim SomaRegistros As Long
    Dim UltimaLinha As Long
    Dim k As Long
    
    'Somar os registros
    UltimaLinha = Sheets("registro").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    If UltimaLinha < 2 Then UltimaLinha = 2
    
    For k = 2 To UltimaLinha
        SomaRegistros = SomaRegistros + CLng(Range("h" & k).Value)
    Next

    Set conn1 = New ADODB.Connection
    With conn1
        .Provider = "Microsoft.JET.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
        .Open
    End With

     
    
    
       'Atualiza o label da soma de registros
    If SomaRegistros <> 0 Then
        LabelSomaRegistros.Caption = "Soma dos Registros: " & SomaRegistros
    End If
    ' Fecha o conjunto de registros.
    Set rst1 = Nothing
    ' Fecha a conexão.
    conn1.Close

    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    conn.Close

TrataSaida:
    Exit Sub
TrataErro:
    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
    
    
           Dim wis As Worksheet
   
    Dim TextoCelula As String
   
    
   
    
    
    
    
    

    
    
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets(1)
    i = 1
    lstLista.Clear
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
               lstLista.AddItem .Cells(i, 1)
            End If
            i = i + 1
        Wend
      
    
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.JET.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
        .Open
    End With

    sql = "SELECT * FROM [Fornecedores$]"

    'monta a cláusula WHERE
    'NomeDaEmpresa
     Call MontaClausulaWhere(txtNomeEmpresa.Name, "NomeDaEmpresa", sqlWhere)

    Call MontaClausulaWhere(Me.Txt_PESQNOME.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.txtNomeCOMPANY.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.Text_pesqdata.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.Text_pesqmatricula.Name, "NomeDaEmpresa", sqlWhere)
    
    Call MontaClausulaWhere(Me.TextBoxCARGO.Name, "NomeDaEmpresa", sqlWhere)

    'faz a união da string SQL com a cláusula WHERE
    If sqlWhere <> vbNullString Then
        sql = sql & " WHERE " & sqlWhere
    End If

    'faz a união da string SQL com a cláusula ORDER BY
   

    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open sql, conn, adOpenDynamic, _
              adLockBatchOptimistic
    End With

    'pega o número de registros para atribuí-lo ao listbox
    lstLista.ColumnCount = rst.Fields.Count

    'preenche o combobox com os nomes dos campos
    'persiste o índice
    
    
    For Each campo In rst.Fields
     
    Next
    'recupera o índice selecionado


    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.EOF And Not rst.BOF Then
        myArray = rst.GetRows
        'troca linhas por colunas no Array
        myArray = Array2DTranspose(myArray)
        'atribui o Array ao listbox
        lstLista.List = myArray
        'adiciona a linha de cabeçalho da coluna
        lstLista.AddItem , 0
        'preenche o cabeçalho
        For i = 0 To rst.Fields.Count - 1
            lstLista.List(0, i) = rst.Fields(i).Name
        Next i
        'seleciona o primeiro item da lista
        lstLista.ListIndex = 0
    Else
        lstLista.Clear
    End If

    'atualiza o label de mensagens
    If lstLista.ListCount <= 0 Then
        lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
    Else
        lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
    End If

    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    conn.Close


    Exit Sub

    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
    End With

    
    Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
    
    
    
End Sub