NOVO CODIGO

ROBSONSLZ 12/08/2010 14:00:20
#350086
Como faço para gerar um novo CÓDIGO automático?

[ô]Declaração
Dim Con As Connection
Dim Rs As Recordset
Dim Diretorio As String

Private Sub cmdEditaCancela_Click()
On Error GoTo Err

TxtCod.Locked = False
TxtNome.Locked = False
TxtNome.SetFocus
Rs.CancelUpdate
Err:
MsgBox Err.Number & [Ô] - [Ô] & Err.Description & [Ô].[Ô], vbCritical, [Ô]Erro[Ô]
End Sub

[ô]Botão Novo e Salvar
Private Sub cmdNovoGrava_Click()
On Error GoTo Err
Rs.AddNew
Call NewCod [ô]Gera Codigo automático
TxtCod.Locked = False
TxtNome.Locked = False
TxtNome.SetFocus
Rs.UpdateBatch
Exit Sub
Err:
MsgBox Err.Number & [Ô] - [Ô] & Err.Description & [Ô].[Ô], vbCritical, [Ô]Erro[Ô]
End Sub

Private Sub Form_Load()
Set Con = New Connection
Set Rs = New Recordset
Con.CursorLocation = adUseClient
Con.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=[Ô] & App.Path & [Ô]\Banco\Dados.mdb;Persist Security Info=False;Jet OLEDB:Database Password=;Jet OLEDB:Encrypt Database=False;Jet OLEDB:SFP=False[Ô]
Rs.Open [Ô]SELECT * FROM TabUsuario[Ô], Con, adOpenStatic, adLockOptimistic

Set TxtCod.DataSource = Rs
Set TxtNome.DataSource = Rs
End Sub

Private Sub NewCod()
Dim NewId As String
With Rs
If Rs.BOF = True And Rs.EOF = True Then
NewId = 1
Else
Rs.MoveLast
NewId = Rs!Codigo + 1 [ô]Codigo: Campo da Tabela do Banco
End If
TxtCod.Text = Format(NewId, [Ô]0000[Ô])
End With
End Sub
DANIKULL 12/08/2010 14:44:05
#350091
Boa tarde.

Onde está sua dúvida???
Veja esta subrotina:

Private Sub NewCod()

    Dim NewId As String
        
    With Rs
        If Rs.BOF = True And Rs.EOF = True Then
            NewId = 1
        Else
            Rs.MoveLast
            NewId = Rs!Codigo + 1 [ô]Codigo: Campo da Tabela do Banco
        End If
        TxtCod.Text = Format(NewId, [Ô]0000[Ô])
    End With
    
End Sub


é ela que gera o código automaticamente, como?

Ela checa a tabela nesta linha de conexão com o DB
 Rs.Open [Ô]SELECT * FROM TabUsuario[Ô], Con, adOpenStatic, adLockOptimistic

Verifica se há registros, e se 
If Rs.BOF = True And Rs.EOF = True Then
ele diz que o novo código será 1, agora se for False esta verificação ele da um MoveLast na tabela para setar o ultimo registro e na Variável NewId ele soma esta ultimo registro mais 1. Feito isto ele joga o valor na TextBox txtCod nesta linha
 TxtCod.Text = Format(NewId, [Ô]0000[Ô])


Ok???
Dúvidas poste novamente.
DANIKULL 12/08/2010 14:46:03
#350092
Há só pra completar....
Nesta rotina a Index do Banco de Dados não pode ser AutoNumeração, porque se não vai gerar erro.
ROBSONSLZ 12/08/2010 17:23:18
#350107
Citação:

:
Há só pra completar....
Nesta rotina a Index do Banco de Dados não pode ser AutoNumeração, porque se não vai gerar erro.



Não está como autonumeração, está como texto.

Aqui não conseguir. Tá dando erro.

Verifique com o anexo...
MSMJUDAS 12/08/2010 17:28:19
#350109 Resposta escolhida
Função para o próximo código:

Public Function ProximoCodigo(vTabela As String, vCampo As String, vCondicao As String)
Dim RsCodigo As New ADODB.Recordset
Sql = [Ô]SELECT MAX([Ô] & Trim(vCampo) & [Ô]) AS CODIGO FROM [Ô] & Trim(vTabela) & [Ô] [Ô] & vCondicao & [Ô][Ô]
RsCodigo.Open Sql, dbBanco, adOpenKeyset, adLockReadOnly
If IsNull(RsCodigo([Ô]CODIGO[Ô])) = True Then
ProximoCodigo = 1
Else
ProximoCodigo = RsCodigo([Ô]CODIGO[Ô]) + 1
End If
RsCodigo.Close: Set RsCodigo = Nothing
End Function

Chamando:

ProximoCodigo([Ô]CLIENTES[Ô], [Ô]CLI_CODIGO[Ô], [Ô][Ô])
ROBSONSLZ 12/08/2010 18:54:19
#350118
Citação:

:
Função para o próximo código:

Public Function ProximoCodigo(vTabela As String, vCampo As String, vCondicao As String)
Dim RsCodigo As New ADODB.Recordset
Sql = [Ô]SELECT MAX([Ô] & Trim(vCampo) & [Ô]) AS CODIGO FROM [Ô] & Trim(vTabela) & [Ô] [Ô] & vCondicao & [Ô][Ô]
RsCodigo.Open Sql, dbBanco, adOpenKeyset, adLockReadOnly
If IsNull(RsCodigo([Ô]CODIGO[Ô])) = True Then
ProximoCodigo = 1
Else
ProximoCodigo = RsCodigo([Ô]CODIGO[Ô]) + 1
End If
RsCodigo.Close: Set RsCodigo = Nothing
End Function

Chamando:

ProximoCodigo([Ô]CLIENTES[Ô], [Ô]CLI_CODIGO[Ô], [Ô][Ô])



Dando erro...
MSMJUDAS 13/08/2010 15:45:17
#350182
Dá uma olhada aí
Tópico encerrado , respostas não são mais permitidas
Voltar