Dicas do OsmarJr |
Uma Numeração de Registros |
|
'-------------------------------------------------------------------------------------------------
' 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 |