Dicas do OsmarJr

Uma Numeração de Registros



Esta é uma forma para manter números sequenciais em uma tabela Access.

Autor:

'-------------------------------------------------------------------------------------------------
' Numeração
'
'   Procura pelo próximo número livre a ser usado
'   como Valor Padrão no form de entrada.
'
'   Para que o código possa ser utilizado em diversas
'   tabelas do mesmo MDB, o nome da tabela deve ser passado como parâmetro.
'   O campo contador deve ter o mesmo nome em todas as tabelas: "NroCH"
'   ou qualquer outro nome, desde que seja substituído no código abaixo...
'--------------------------------------------------------------------------------------------------
Public Function Numeração(tNomeTbl As String) As Long
On Error GoTo Numeração_Err
Dim DB As Database
Dim RS As Recordset
Dim fCntFld As Field
Dim lTmpVal As Long
Dim lValAtu As Long
Dim lValRet  As Long
Dim Furos As Integer
Dim lUltNum As Long
Dim lNumReg As Long
Dim strSQL As String

   strSQL = "SELECT NroCH FROM " & tNomeTbl & ";"
   Set DB = DBEngine(0)(0)
   Set RS = DB.OpenRecordset(strSQL, DB_OPEN_DYNASET)
   
'  Inicializa o pointer do campo para ganhar velocidade
   Set fCntFld = RS!NroCH
'   Vai para o último registro, pega seu valor e contagem de registros
   If Not RS.BOF Then        
' não está vazia
       RS.MoveLast
       lUltNum = fCntFld
       lNumReg = RS.RecordCount
'   Se o número de registros existentes for menor que o último número usado
'   existem furos no contador (provavelmente registros excluídos)
       Furos = lUltNum - lNumReg
   Else
'   Se a tabela estiver vazia, obviamente o número para o contador é 1
       lValRet = 1
       GoTo CleanUp
   End If
'   Se existir furo, pega o primeiro número não utilizado para ser devolvido pela função
   If Furos > 0 Then
       lTmpVal = 0                
'   Inicializa a variável temporáia em zero como primeiro registro pode ter sido excluído
       RS.MoveFirst              
'     Começa do início...
       Do Until RS.EOF          
'      e vai até o fim...
           lValAtu = fCntFld
           If lValAtu > lTmpVal + 1 Then  
'   Se o valor for maior que o registro anterior mais um, achamos o furo
               lValRet = lTmpVal + 1              
'   Passa-o para a variável de retorno
               Exit Do                                      
'  Foge do  loop
           End If
           lTmpVal = lTmpVal + 1                  
'   incrementa a variável temporária ( lTmpVal)
           RS.MoveNext                                
'   Vai para o próximo registro
       Loop
   Else
'   Se não há furos, devolve o último número usado mais um
       lValRet = lUltNum + 1
   End If

CleanUp:
'   Fecha e apaga a query temporária
   RS.Close
'   Passa a variável temporária para a função
   Numeração = lValRet
Numeração_Exit:
   Exit Function

Numeração_Err:
   If Err <> 3021 Then    
'   Erro 3021 ocorre quando a tabela está completamente vazia...
       MsgBox "Error: " & Err & " " & Error$, 0, "Numeração"
   Else    
'   Significa que estamos com o registro número 1
       If lValRet = 0 Then lValRet = 1
   End If
   Resume CleanUp
End Function
Home

Contato | Copyright©Osmar José Correia Júnior | 09-Mar-2006 17:28