Macro Protocolo sequencial ano/texto/nº sequencial

[Haf1986]

Olá a todos!

Estou montando uma planilha Excel para protocolo de ofícios recebidos,  mas não consegui fazer  do jeito que queria.

 

Quando clico em novo, geram protocolos sequenciais como: 

1

2

3

etc.. na seguinte formula:

 

Private Sub BNovo_Click()

linha = 2

cont = 1

Do Until Sheets("Oficios").Cells(linha, 1) = ""

cont = cont + 1

linha = linha + 1

Loop

txtprotocolo.Text = cont

End Sub

 

Queria uma fórmula que gerasse a sequência ano/of/número sequencial. Ex.:

2015/of/001

2015/of/002

etc... e quando iniciasse o ano de 2016, reiniciaria a contagem.

 

 

Agradeço desde já!

[Visitante]

Experimente o código abaixo.

Se não resolver sugiro que você disponibilize uma amostra do seu arquivo.

Private Sub BNovo_Click() Dim LR As Long  With Sheets("Oficios")   LR = .Cells(Rows.Count, 1).End(xlUp).Row    If .Cells(LR, 1) = "" Or Val(Left(.Cells(LR, 1), 4)) < Year(Date) Then     .Cells(LR + 1, 1) = Year(Date) & "/Ofício/001"    Else: .Cells(LR + 1, 1) = Year(Date) & "/Ofício/" & Format(Right(.Cells(LR, 1), 3) + 1, "000")    End If   txtprotocolo.Text = .Cells(LR + 1, 1)  End WithEnd Sub

[Haf1986]

Agradeço Osvaldo!!

 

Deu certo....

[Haf1986]

Boa tarde Osvaldo!

 

Deu certo, mas está criando dois registros simultâneos..

 

Vou encaminhar a planilha.

Ofícios V0.3.rar

[Visitante]

Experimente.

Private Sub BNovo_Click()Dim LR As Long  With Sheets("Oficios")   LR = .Cells(Rows.Count, 1).End(xlUp).Row    If .Cells(LR, 1) = "" Or Val(Left(.Cells(LR, 1), 4)) < Year(Date) Then     txtprotocolo.Text = Year(Date) & "/Ofício/001"    Else: txtprotocolo.Text = Year(Date) & "/Ofício/" & Format(Right(.Cells(LR, 1), 3) + 1, "000")    End If  End WithEnd Sub

 

[Haf1986]

Boa noite Osvaldo!

Quando chega na sequência 2015/Ofício/1000 ele retorna para 2015/Ofício/0001

Como eu posso resolver este entrave.

 

Agradeço

[Visitante]

substitua esta linha

Else: txtprotocolo.Text = Year(Date) & "/Ofício/" & Format(Right(.Cells(LR, 1), 3) + 1, "000")

por esta

Else: txtprotocolo.Text = Year(Date) & "/Ofício/" & Format(Right(.Cells(LR, 1), Len(.Cells(LR, 1)) - 12) + 1, "000")