Home Excel - Dicas Microsoft Excel VBA Excel VBA - Userforms e outros Excel vba planilha ListView busca dados soma valores

Excel vba planilha ListView busca dados soma valores

Dom, 31 de Março de 2013 11:20 Expedito Marcondes
E-mail Imprimir PDF

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Esses procedimentos do Aplicativo Microsoft Excel VBA(visual Basic Application), com auxilio de um objeto ListView busca dados baseados
em determinados critérios e retorna também a soma dos valores Filtrados no objeto ListView, contém folha de planilha para o relatório de
dados filtrados.


Option Explicit
Dim TabelaTemp As Variant
Dim vUltimaLinha As Integer
Dim L As Integer
Dim X As Integer
Dim I As Integer
Dim C As Byte
Dim vLin As Integer
Dim TotalCol As Single

Private Sub CheckBox1_Click()
  If frmLANCAMENTOS.CheckBox1.Value = True Then Call AdicionaItem
End Sub

Private Sub cbxAGENCIA_Change()
  If frmLANCAMENTOS.CheckBox1.Value = True Then
    Call AdicionaItem
    Exit Sub
  End If
  If frmLANCAMENTOS.cbxAGENCIA.Value = "" Then Exit Sub
  ' verifica a combobox lista meses
  frmLANCAMENTOS.cbxMESES.Value = ""
  ' & Se desmarcada, construído de acordo com a agência lista
  With Me.ListView1
    .ListItems.Clear
    With .ColumnHeaders
      .Clear
      .Add , , "Data", 50
      .Add , , "Agencia", 70
      .Add , , "Cliente", 95
      .Add , , "Total", 50
    End With
    .FullRowSelect = True
    .Gridlines = True
    .LabelEdit = 1
    .ListItems.Clear
    .View = lvwReport
    With ThisWorkbook.Worksheets("BD")
      .Activate
      vUltimaLinha = .Range("A65535").End(xlUp).Row
      TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
      .Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    X = 1
    TotalCol = 0
    For L = 1 To UBound(TabelaTemp, 1)
      If TabelaTemp(L, 2) = Me.cbxAGENCIA.Value Then
        .ListItems.Add , , TabelaTemp(L, 1)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
        TotalCol = TotalCol + TabelaTemp(L, 4)
        X = X + 1
      End If
    Next
  End With
'TOTAL
Me.TotListView.Value = TotalCol
  With Me.txtTotal
       Me.txtTotal = ListView1.ListItems.Count - 0
  End With
End Sub

Private Sub cbxMESES_Change()
  If frmLANCAMENTOS.CheckBox1.Value = True Then
    Call AdicionaItem
    Exit Sub
  End If
  If frmLANCAMENTOS.cbxMESES.Value = "" Then Exit Sub
     frmLANCAMENTOS.cbxAGENCIA.Value = ""
  '  Se desmarcada, construído a lista por MÊS
  With Me.ListView1
         .ListItems.Clear
    With .ColumnHeaders
       .Clear
       .Add , , "Data", 50
       .Add , , "Agencia", 70
       .Add , , "Cliente", 95
       .Add , , "Total", 50
    End With
    .FullRowSelect = True
    .Gridlines = True
    .LabelEdit = 1
    .ListItems.Clear
    .View = lvwReport
    With ThisWorkbook.Worksheets("BD")
      .Activate
      vUltimaLinha = .Range("A65535").End(xlUp).Row
      TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
      .Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    X = 1
    TotalCol = 0
    For L = 1 To UBound(TabelaTemp, 1)
      If Format(CDate(TabelaTemp(L, 1)), "mmmm") = Me.cbxMESES.Value Then
        .ListItems.Add , , TabelaTemp(L, 1)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
        .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
        TotalCol = TotalCol + TabelaTemp(L, 4)
        X = X + 1
      End If
    Next L
  End With
  Me.TotListView.Value = TotalCol
'TOTAL
With Me.txtTotal
     Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Sub AdicionaItem()
  With Me.ListView1
    .ListItems.Clear
    With .ColumnHeaders
      .Clear
      .Add , , "Data", 50
      .Add , , "Agencia", 70
      .Add , , "Cliente", 95
      .Add , , "Total", 50
    End With
    .FullRowSelect = True
    .Gridlines = True
    .LabelEdit = 1
    .ListItems.Clear
    .View = lvwReport
      With ThisWorkbook.Worksheets("BD")
        .Activate
        vUltimaLinha = .Range("A65535").End(xlUp).Row
        TabelaTemp = .Range(.Cells(2, 1), .Cells(vUltimaLinha, 4)).Value
        .Range("A1").Sort Key1:=.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      End With
    X = 1
    TotalCol = 0
    For L = 1 To UBound(TabelaTemp, 1)
      If TabelaTemp(L, 2) = Me.cbxAGENCIA.Value Then
        If Format(CDate(TabelaTemp(L, 1)), "mmmm") = Me.cbxMESES.Value Then
          .ListItems.Add , , TabelaTemp(L, 1)
          .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 2)
          .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 3)
          .ListItems(X).ListSubItems.Add , , TabelaTemp(L, 4)
          TotalCol = TotalCol + TabelaTemp(L, 4)
          X = X + 1
        End If
      End If
    Next L
  End With
'TOTAL
Me.TotListView.Value = TotalCol
With Me.txtTotal
     Me.txtTotal = ListView1.ListItems.Count - 0
End With
End Sub

Private Sub cmdFECHAR_Click()
Unload Me
End Sub

Private Sub UserForm_initialize()
 cbxAGENCIA.RowSource = "Lista!A2: A10"
 cbxMESES.RowSource = "Lista!B2: B13"
End Sub

'IMPRESSAO
Private Sub cmdImprimer_Click()
vLin = 1
With Me.ListView1
For I = 1 To .ListItems.Count
vLin = vLin + 1
Sheets("Impressao").Cells(vLin, 1) = .ListItems(I)
Sheets("Impressao").Cells(vLin, 2) = .ListItems(I).ListSubItems(1)
Sheets("Impressao").Cells(vLin, 3) = .ListItems(I).ListSubItems(2)
Sheets("Impressao").Cells(vLin, 4) = .ListItems(I).ListSubItems(3)
Next I
End With
MsgBox "dados imprimidos com sucesso folha impressao", vbInformation, "Escola Saberexcel VBA Estudos®"
'sbx_impressao
'sbx_limpar_Impressao
End Sub

 
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.



Baixe o exemplo de planilha contendo os objetos e procedimentos aicma.
icon Excel vba planilha ListView busca dados soma valores (52.97 KB)

Tags:
Última atualização em Dom, 31 de Março de 2013 11:41  

Adicionar comentário

"Jamais considere seus estudos como uma obrigação, mas como uma oportunidade invejável para aprender a conhecer a influência libertadora da beleza do reino do espírito, para seu próprio prazer pessoal e para proveito da comunidade." Albert Einstein

Código de segurança
Atualizar

PROMOÇÃO DIDÁTICOS SABEREXCEL



Adquira já o Acesso Imediato
à Area de Membros

Compra Grantida --- Entrega Imediata

Aprenda Excel VBA com Simplicidade de 
códigos e Eficácia, Escrevendo Menos e
Fazendo Mais.

'-------------------------------------'
Entrega Imediata:
+  500 Video Aulas MS Excel VBA
+  35.000 Planilhas Excel e VBA
+  Coleção 25.000 Macros MS Excel VBA
+  141 Planilhas Instruções Loops
+  341 Planilhas WorksheetFunctions(VBA)
+    04 Módulos Como Fazer Excel VBA
+  Curso Completo MS Excel VBA
+  Planilhas Inteligentes

Pesquisa Google SaberExcel

Google

Contatos Equipe Saberexcel

Navegar pelo Site

Outros Assuntos

Publicidade Google

<script type="text/javascript"><!--

google_ad_client = "ca-pub-2317234650173689";

/* retangulo 336 x 280 */

google_ad_slot = "0315083363";

google_ad_width = 336;

google_ad_height = 280;

//-->

</script>

<script type="text/javascript"

src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

</script>

Publicidade

Tags Populares

RSFirewallProtected

23.11.2024

Google Associados

Depoimentos

Adicione Saberexcel Favoritos

 
 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


   Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA