Amigos e mestres,
Com ajuda aqui do site consegui criar um módulo que gera a numeração automatica com digito verificador, porém, ao implementar no sistema mesmo com o campo da tabela nao permitindo duplicidade, as vezes, o sistema emite um aviso informando que nao pode salvar dados pois esta com dado duplicado.
Abaixo segue o código, se alguem puder me ajudar agradeço!
Option Compare Database
Public comando As String
Public banco As Database
Public dataset As Recordset
Function conecta()
Set banco = CurrentDb
End Function
Function valida_selecao()
Set dataset = banco.OpenRecordset(comando, dbOpenDynaset)
End Function
Public Function Contador(strCampo As String, ACP As String) As Variant
Dim letra As String, strNumero As String
Dim numero As Integer, I As Integer
Dim COD As String, COD0 As String
Dim COD1 As Integer, COD2 As Integer
Dim COD3 As String, COD4 As String
Dim F1 As Integer, F2 As Integer
Dim F3 As Integer, F4 As Integer
Dim Soma1 As Integer, Soma2 As Integer
Dim Soma As Integer, Digito As Integer
Dim NumeroACP As String
Dim strSQL As String, rkt As DAO.Recordset
'For I = 65 To 90
' letra = Chr(I)
'Next
I = Int((90 - 65 + 1) * Rnd + 65)
letra = Chr(I)
numero = Int((9999 - 1 + 1) * Rnd + 1)
strNumero = Format(numero, "0000")
COD = letra + strNumero
'Separa a variável COD em partes
COD0 = (I - 65)
COD1 = (Left$(COD0, 1))
COD2 = (Right$(COD0, 1)) * 2
Soma1 = COD1 + (Left$(COD2, 1)) + (Right$(COD2, 1))
F1 = Val(Mid(numero, 1, 1))
F2 = Val(Mid(numero, 2, 1)) * 2
F3 = Val(Mid(numero, 3, 1))
F4 = Val(Mid(numero, 4, 1)) * 2
COD3 = Format(F2, "00")
COD4 = Format(F4, "00")
Soma2 = F1 + Left(COD3, 1) + Right(COD3, 1) + F3 + Left(COD4, 1) + Right(COD4, 1)
Soma = Soma1 + Soma2
'Gera o dígito verificador
Digito = 10 - (Soma Mod 10)
If Digito = 10 Then Digito = 0
'Cria o número da ACP
NumeroACP = COD + Trim$(Str$(Digito))
If DCount("Codigo", "ACP", Codigo = NumeroACP) = 0 Then
Contador = NumeroACP
Else
Contador = Null
End If
strSQL = "SELECT DISTINCT Max" & "(" & strCampo & ")" & " As MaxValor"
strSQL = strSQL & " FROM " & ACP
Set rkt = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)
' Contador = NumeroACP
rkt.Close: Set rkt = Nothing
End Function
Com ajuda aqui do site consegui criar um módulo que gera a numeração automatica com digito verificador, porém, ao implementar no sistema mesmo com o campo da tabela nao permitindo duplicidade, as vezes, o sistema emite um aviso informando que nao pode salvar dados pois esta com dado duplicado.
Abaixo segue o código, se alguem puder me ajudar agradeço!
Option Compare Database
Public comando As String
Public banco As Database
Public dataset As Recordset
Function conecta()
Set banco = CurrentDb
End Function
Function valida_selecao()
Set dataset = banco.OpenRecordset(comando, dbOpenDynaset)
End Function
Public Function Contador(strCampo As String, ACP As String) As Variant
Dim letra As String, strNumero As String
Dim numero As Integer, I As Integer
Dim COD As String, COD0 As String
Dim COD1 As Integer, COD2 As Integer
Dim COD3 As String, COD4 As String
Dim F1 As Integer, F2 As Integer
Dim F3 As Integer, F4 As Integer
Dim Soma1 As Integer, Soma2 As Integer
Dim Soma As Integer, Digito As Integer
Dim NumeroACP As String
Dim strSQL As String, rkt As DAO.Recordset
'For I = 65 To 90
' letra = Chr(I)
'Next
I = Int((90 - 65 + 1) * Rnd + 65)
letra = Chr(I)
numero = Int((9999 - 1 + 1) * Rnd + 1)
strNumero = Format(numero, "0000")
COD = letra + strNumero
'Separa a variável COD em partes
COD0 = (I - 65)
COD1 = (Left$(COD0, 1))
COD2 = (Right$(COD0, 1)) * 2
Soma1 = COD1 + (Left$(COD2, 1)) + (Right$(COD2, 1))
F1 = Val(Mid(numero, 1, 1))
F2 = Val(Mid(numero, 2, 1)) * 2
F3 = Val(Mid(numero, 3, 1))
F4 = Val(Mid(numero, 4, 1)) * 2
COD3 = Format(F2, "00")
COD4 = Format(F4, "00")
Soma2 = F1 + Left(COD3, 1) + Right(COD3, 1) + F3 + Left(COD4, 1) + Right(COD4, 1)
Soma = Soma1 + Soma2
'Gera o dígito verificador
Digito = 10 - (Soma Mod 10)
If Digito = 10 Then Digito = 0
'Cria o número da ACP
NumeroACP = COD + Trim$(Str$(Digito))
If DCount("Codigo", "ACP", Codigo = NumeroACP) = 0 Then
Contador = NumeroACP
Else
Contador = Null
End If
strSQL = "SELECT DISTINCT Max" & "(" & strCampo & ")" & " As MaxValor"
strSQL = strSQL & " FROM " & ACP
Set rkt = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)
' Contador = NumeroACP
rkt.Close: Set rkt = Nothing
End Function