| 
Declaração de variáveis visíveis em todo o formulário.
Option Explicit
Private numero_registros As Variant 'contador de registros
Const colindex_lista = 1 'coluna onde será mostrada a lista de itens
Evento Reposition do controle de dados
Private Sub Data1_Reposition() 'ao iniciar
  '-----------------------------atualiza o total no controle SSPanel---------
  If pnltotal.Caption = "" Then
    Soma_Colunas Grid, Data1, "valor", pnltotal, "##,##0.00" 'chama rotina de soma
  End If
    
  '-----------------verifica se o contador esta vazio--------------------
  If IsEmpty(numero_registros) Then
    numero_registros = Conta_Registros(Data1) 'conta os registros
  End If
  With Data1
    If .Recordset.RecordCount Then  'se há registros mostra a posição
        .Caption = " Registro : " & (.Recordset.AbsolutePosition + 1) & " / " & numero_registros
    Else
        .Caption = " O arquivo esta vazio "
    End If
  End With
End Sub
Evento Validate do controle de dados
Private Sub Data1_Validate(Action As Integer, Save As Integer)
   
   'dependendo da ação incrementa ou decrementa o contador de registros
   Select Case Action
       Case vbDataActionAddNew 'inclusão
          numero_registros = numero_registros + 1
       Case vbDataActionDelete 'exclusão
          numero_registros = numero_registros - 1
   End Select
End Sub
Carga do formulário
Private Sub Form_Load()
 'formata o grid
 Grid.Columns(0).Width = 2500 'nome
 Grid.Columns(1).Width = 1550 'curso
 Grid.Columns(2).Width = 1000 'valor
 Grid.Columns(0).Alignment = 0 'alinha a esquerda
 Grid.Columns(1).Alignment = 0
 Grid.Columns(2).Alignment = 1 'alinha
 
 'enche a lista com os itens
 With Lista
   .AddItem "Matemática"
   .AddItem "Agronomia"
   .AddItem "Arquitetura"
   .AddItem "Física"
   .AddItem "Engenharia"
   .AddItem "Inglês"
   .AddItem "Química"
   .AddItem "Biologia"
   .AddItem "Proc. de Dados"
   .AddItem "Psicologia"
   .AddItem "Ed. Física"
End With
 
Data1.Refresh
'mostra o botão na coluna definida
Grid.Columns(colindex_lista).Button = True
 
'define célula selecionada(curso) como negra
Grid.MarqueeStyle = dbgHighlightCell
End Sub
Procedimento para Somar as colunas
Public Sub Soma_Colunas(dbg As DBGrid, dados As Data, nomecampo As String, _
pnl As SSPanel, num_formato As String)
Dim soma As Single
Dim rs As Recordset
'so para se previnir
On Error GoTo trata_erro
Set rs = dados.Recordset.clone
'rotina para somar a coluna escolhida(valor)
Do Until rs.EOF
   soma = soma + Val(rs(nomecampo))
   rs.MoveNext
Loop
pnl = Format(soma, num_formato)
Exit Sub
trata_erro:
  MsgBox "Ocorreu um erro durante o processamento, verifique ! "
End Sub
Evento AfterUpdate do Grid
Private Sub Grid_AfterUpdate() 'atualizar após modificar/inserir dados
    Soma_Colunas Grid, Data1, "valor", pnltotal, "##,##0.00"
End Sub
Evento BeforeColEdit
Private Sub Grid_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
  If ColIndex = colindex_lista Then  'força a seleção da lista
     Cancel = True
     Grid_ButtonClick (ColIndex)
  End If
End Sub
Evento ButtonClick do Grid
Private Sub Grid_ButtonClick(ByVal ColIndex As Integer)
  Dim coluna As Column
  
  'mostra a lista abaixo da coluna selecionada
  If ColIndex = colindex_lista Then
     Set coluna = Grid.Columns(ColIndex)
     
     With Lista
        .Left = Grid.Left + coluna.Left
        .Top = Grid.Top + Grid.RowTop(Grid.Row) + Grid.RowHeight
        .Width = coluna.Width + 15
        .ListIndex = 0
        .Visible = True
        .ZOrder 0
        .SetFocus
     End With
  
  End If
End Sub
Evento Scroll do Grid
Private Sub Grid_Scroll(Cancel As Integer)
   'oculta a lista se rolar o grid
   Lista.Visible = False
End Sub
Evento DblClick do ListBox
Private Sub Lista_DblClick()
  'assume o valor clicado
  Lista_KeyPress vbKeyReturn
End Sub
Evento KeyPress do Grid
Private Sub Lista_KeyPress(KeyAscii As Integer)
  'verifica a tecla pressionada e dispara ação pertinente
  Select Case KeyAscii
     Case vbKeyReturn
        Grid.Columns(colindex_lista).Text = Lista.Text
        Lista.Visible = False
     Case vbKeyEscape
        Lista.Visible = False
  End Select
End Sub
Evento LostFocus do ListBox
Private Sub Lista_LostFocus()
   'oculta a lista ao perder foco
   Lista.Visible = False
End Sub
Função para contar os registros (Utilize um módulo)
Function Conta_Registros(dados As Data) As Long
   Dim copia As Recordset, n As Long
   
   If dados.Recordset.RecordCount Then 'se há registros atualiza contador
      Set copia = dados.Recordset.Clone
      copia.MoveLast
      n = copia.RecordCount
   Else
      n = 0 'se não há registros zera o contador
   End If
   Conta_Registros = n 'atribui numero de registros a função
 
End Function
 |