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
|