[Resolvido]Criar autonumeração xxxx/n

Eu gostaria de criar um número de cadastro personalizado (autonumeração). Seria o seguinte: xxxx/n. Onde xxxx é um ano que eu mesmo vou digitar e n seria um número em ordem crescente que apareceria automaticamente após eu atulizar o campo com o ano (xxxx). Vamos supor que eu já tenha cadastrado seis pacientes com o ano 2006, então apareceria 2006/007; dez pacientes com o ano 2010, então apareceria 2010/011. etc

Se alguém puder ajudar a desenvolver o código. Obrigado

Bom dia amigo

Procure nos exemplos do repositório, pois tem vários exemplos de contadores com datas. Na autonumeração do Access você só pode formatar com zeros:000000000

Não tem nada nem parecido com oque eu quero no repositório. Obrigado

Bom dia, Antony

Dê-nos elementos: nome da tabela, nome e tipo dos campos envolvidos, etc.
Cumprimentos,

Tentei começar a desenvolver o código mas não consegui, talvez pq a função Dcount seja limitada para o que eu desejo, talvez seja por erro de sintaxe. Inicialmente a função que desenvolvi funciona:

Me.Private Sub Codigo_AfterUpdate()
Codigo = DCount("[codigo]", "dadoscomuns", "[codigo] = '" & Codigo & "'")
End sub

Mas depois que eu tento utilizar a função left, ela não obedece da maneira que eu preciso:

Me.Private Sub Codigo_AfterUpdate()
Me.Codigo = DCount("Left([codigo],4)", "dadoscomuns", "[codigo] = '" & Left(Codigo, 4) & "'")
End sub

Consegui desenvolver a parte crítica do código. Agora so necessito incorporar o ano que digitei no campo código ao número que a função abaixo me retorna. Alguma sujestão?

Private Sub Codigo_AfterUpdate()
If Not IsNull(Me.Codigo) Then
Dim contadorcodigo As Integer

contadorcodigo = DCount("[codigo]", "dadoscomuns", "Left([codigo],4) = '" & codigo & "'")

Me.Codigo.Value = contadorcodigo + 1
End If

End Sub

Adapte ou utilize e bom trabalho tem 2 à sua escolha

Função Contador no formato número/ano

Public Function ContadorDeRegistros(strCampo As String, strSql As String)
'Contador de registros personalizado no formato numero/ano
Dim strNum As String, DB As Database
Dim strMax As String, CampoAno As String
Dim AnoData As String, tbl As Recordset

Set DB = CurrentDb
'Ano tirado da data do sistema
AnoData = Year(Date)

'Abre a Tabela
Set tbl = DB.OpenRecordset(strSql)
'Se não há registros na tabela
If tbl.RecordCount = 0 Then
'Primeiro registro
ContadorDeRegistros = 1 & "/" & AnoData
Else
'pega o registro
strMax = tbl(strCampo)
'Pega o ano
CampoAno = Mid(strMax, (InStr(1, strMax, "/")) + 1, 4)
'Aqui testo o Ano do último registro com o do sistema
'Se for igual continue a contagem se não...
If CampoAno = AnoData Then
strNum = Left(strMax, (InStr(1, strMax, "/") - 1)) + 1
ContadorDeRegistros = strNum & "/" & AnoData
Else
MsgBox "O sistema iniciará uma nova contagem dos registros" _
& vbCrLf & " em função da virada do ano", vbInformation, "ATENÇÃO"
ContadorDeRegistros = 1 & "/" & AnoData
End If
End If
'formata o número
ContadorDeRegistros = StrZero(ContadorDeRegistros, 10)
tbl.Close
Set DB = Nothing
End Function
....................................................................................

Contador no formato número/mês/ano

Public Function ContarReg(NomeCampo As String, NomeTabela As String)
'Contador de registros personalizado no formato numero/mes/ano
Dim DB As Database
Dim tbl As Recordset, strNum As String
Dim strMax As String, CampoMes As String
Dim MesData As String, AnoData As String

Set DB = CurrentDb
MesData = Format(Date, "mmm")
AnoData = Format(Date, "yy")

Set tbl = DB.OpenRecordset(NomeTabela)

If tbl.RecordCount = 0 Then
'Primeiro registro
ContarReg = 1 & "/" & MesData & "/" & AnoData
Else
'pega o registro
strMax = tbl(NomeCampo)
'Aqui pego o mês no último registro
CampoMes = Mid(strMax, (InStr(1, strMax, "/")) + 1, 3)
'Aqui testo o mês digitado com o último registro
'Se for igual então
If CampoMes = MesData Then
strNum = Left(strMax, (InStr(1, strMax, "/") - 1)) + 1
ContarReg = strNum & "/" & CampoMes & "/" & AnoData
Else
Dim intRes As Integer
intRes = MsgBox("O sistema iniciará uma nova contagem pela virada do mês." _
& Chr(10) + Chr(13) & "Você confirma?", vbYesNo, "Atenção")
If intRes = vbYes Then 'respondeu sim
ContarReg = 1 & "/" & MesData & "/" & AnoData
Else 'continua a contagem atual
strNum = Left(strMax, (InStr(1, strMax, "/") - 1)) + 1
ContarReg = strNum & "/" & CampoMes & "/" & AnoData
End If
End If
End If
tbl.Close
Set DB = Nothing
'formata o número
ContarReg = StrZero(ContarReg, 11)
End Function

Já tinha estudado esses exemplos! Não tem muito a ver com oque eu quero. Alguém sabe o código vba para me retornar as ultimas quatro letras digitadas?

Retornar para onde? Você quer digitar em um campo e elas aparecerem em outro? Ou substituir o digitado pelas 4 últimas no mesmo campo?

Utilize a função Rigth para retirar à direita e Left para retirar à esquerda

O problema é que vai ser substituido no mesmo campo. Se fosse em outro seria mais fácil. Eu vou digitar o ano que eu quero. No evento afterupdate do campo ele vai executar a função que eu escrevi:
Private Sub Codigo_AfterUpdate()
If Not IsNull(Me.Codigo) Then
Dim contadorcodigo As Integer
contadorcodigo = DCount("[codigo]", "dadoscomuns", "Left([codigo],4) = '" & codigo & "'")
Me.Codigo.Value = contadorcodigo + 1
End If

End Sub
So esta faltando a ultima linha do código que seria assim:
Me.codigo.value = (o ano que digitei no campo codigo) & "/" & contadorcodigo + 1

Por que não tenta assim:

Me.NomeCampo = Me.NomeCampo & "/" & Format(Right(DMax("Código", "NomeTabela"), 4, "000") + 1

Você insere a data e ao dar Enter, são adicionados os 3 últimos dígitos do maior código mais um.

Consegui criar o código! Alguém sabe como passar ele pra uma public function?
Private Sub codigo_AfterUpdate()
If Not IsNull(Me.Codigo) Then
Dim contadorcodigo As Integer
Dim ano As String
contadorcodigo = DCount("[codigo]", "dadoscomuns", "Left([codigo],4) = '" & Codigo & "'")
ano = Me.Codigo.Value
Me.Codigo.Value = ano & "/" & contadorcodigo + 1
End If
End Sub

Uma dica: não use DCount. Se por algum motivo um registro sumir, vai dar erro. Imagina que você tenha 200 registros e o último seja 200. Se sumir um, ficarão 199 registros. 199+1=200. Acontece que já tem o 200. Por isso eu prefiro usar DMax. Assim, não importa quantos registros tenha, será sempre o maior + 1.

Vc tem toda razão. Mas não estou conseguindo utilizar seu código. Parece que está faltando um parentese... dá erro

Private Sub codigo_AfterUpdate()
If Not IsNull(Me.Codigo) Then

Me.codigo = Me.codigo & "/" & Format(Right(DMax("Codigo", "dadoscomuns), 4, "000") + 1
End If
End Sub

Sim, na expressão colocada estão faltando um parêntese e aspas de fechamento. Observe que você abriu três parênteses e só fechou dois. E ficou faltando fechar aspas em dadoscomuns. Veja se é isso que está faltando.

Coloquei assim:
Private Sub codigo_AfterUpdate()
If Not IsNull(Me.Codigo) Then
Dim contadorcodigo As Integer
Dim ano As String
contadorcodigo = Format(Right(DMax("Codigo", "dadoscomuns"), 4, "000") + 1)
ano = Me.Codigo
Me.Codigo = ano & "/" & contadorcodigo

End If
End Sub
e está dando erro de compilação: Número de argumento incorreto ou atribuição de propriedade inválida.

Teste essa linha assim:

contadorcodigo = Format(Right(DMax("Codigo", "dadoscomuns"), 4), "000") + 1

Parece que consegui! Por favor deem um olhada no código que desenvolvi. obrigado
Public Function ContadordeRegistros(Codigo As String)


Dim Strnum As String, DB As Database
Dim strMax As String, CampoAno As String
Dim AnoData As String, rs As Recordset
Dim Numreg As Integer
Set DB = CurrentDb
Set rs = DB.OpenRecordset("dadoscomuns")
Numreg = rs.RecordCount
AnoData = Codigo


If Numreg = 0 Then
ContadordeRegistros = AnoData & "/" & 1
Else
strMax = Codigo
CampoAno = DCount("[codigo]", "dadoscomuns", "Left([codigo],4) = '" & Codigo & "'")
If CampoAno >= 1 Then
Strnum = DMax("Mid([codigo],6, 3)", "dadoscomuns", "Left([codigo],4) = '" & Codigo & "'") + 1
ContadordeRegistros = AnoData & "/" & Strnum
Else
ContadordeRegistros = AnoData & "/" & 1
End If
End If

Set DB = Nothing

End Function

SE está a funcionar, só temos agradecer o retorno. Obrigado.

Ótimo trabalho, embora eu acho que daria para ter usado apenas uma linha de código com a função que eu passei. Eu tenho isso no evento "Após atualizar" do campo txtCódigo de um aplicativo assim:

Me.txtCódigo = Me.txtCódigo & "/" & Format(Right(DMax("Código", "tblClientes"), 3) + 1, "000")

O campo Código na tabela é tipo Número e está com Formato 0000/000. O código acima é para formatação de campos já existentes. Para adicionar o ano corrente, seria assim:

Me.txtCódigo = Year(Date) & "/" & Format(Right(DMax("Código", "tblClientes"), 3) + 1, "000")

ou ainda assim:

Me.txtCódigo = Format(now, "yyyy") & "/" & Format(Right(DMax("Código", "tblClientes"), 3) + 1, "000")

Obviamente pode-se ainda omitir o campo Me.txtCódigo caso o registro seja gravado via RecordSet, o que seria algo assim:

rs("Código") = Year(Date) & "/" & Format(Right(DMax("Código", "tblClientes"), 3) + 1, "000")

Olá!

Utilizei um código semelhante para gerar automaticamente uma numeração alfanmérica. Funcionou na perfeição, até que dividi a BD em Back e front... Aí dá erro e não executa!

Sabem dizer-me porque será?

Muito e muito obrigada pela vossa atenção!