[Resolvido]Inserção automática de numeração no orçamento duplicado

Prezados bom dia.

Se alguém puder me ajudar nessa empreitada, ficaria agradecido.
Vamos ao problema.
Ao gerar um orçamento duplicado, preciso que seja inserido em uma caixa de texto ( OrcDuplicado, formato texto....esse campo está presente na TblOrcamento) um numero que mostre que o orçamento foi duplicado.

A sequência seria a seguinte:
numero do orçamento original: 01/2017 quem vem da caixa de texto OrcamentoNumero, formato texto.  Ele pega o IDOrcamento (Chave Primária ) e acrescenta o ano(=[IDOrcamento ] & " / " & Ano(Data())).
numero que será gerado pela duplicação: 001
Ficando dessa forma na caixa de texto OrcDuplicado: 01/2017-001

O por que disso...poderá haver acrescimo de itens ou não ! Por isso que é gerado vários orçamentos, ou seja um cliente poderá ter até 5 orçamentos e eu gostaria de ter todos eles com uma sequencia numérica tipo...01/2017-001, 01/2017-002 e assim por diante.

Esse campo, tem que aparecer quando gera o primeiro....segundo..o terceiro..o quarto orçamento para o mesmo cliente, mas sempre tendo como referência o primeiro orçamento que originou todos.

O código que gera está aqui, se alguém puder me ajudar...fico agradecido.

Código:

Private Sub bt_duplicar_Click()
'desenvolvido e adaptado por Silvio
' a rotina para inicar a duplicação do orçamento desejado.
Dim x As String
Dim Data As String
x = DLast("IdOrcamento", "TblOrcamento") + 1

        If Not IsNull(Me!DtOrcamento) Then
            If MsgBox("Confirma a duplicação desse Orçamento ?", vbQuestion + vbYesNo, Me.Caption) = vbNo Then
            MsgBox ("Orçamento não foi duplicado !"), vbInformation, Me.Caption
            Me.Undo
            Exit Sub
            Else
            
                Dim CodigoNovoPedido As Long

                CurrentDb.Execute "INSERT INTO TblOrcamento ( CNPJCPF, IDCliente, ClienteRazaoSocial, Endereco, CEP, Cidade, Fone, CelularWhatApps, Email, ValorTotal, Descontos, ValorTotalGeral, Obs, PrazoEntrega ) SELECT CNPJCPF, IDCliente, ClienteRazaoSocial, Endereco, CEP, Cidade, Fone, CelularWhatApps, Email, ValorTotal, Descontos, ValorTotalGeral, Obs, PrazoEntrega  FROM TblOrcamento WHERE IdOrcamento=" & Me!IdOrcamento & ";", dbFailOnError

                CodigoNovoPedido = DMax("IDOrcamento", Me.RecordSource)

                CurrentDb.Execute "INSERT INTO TblSOrcamento ( IdOrcamento, CodProdFornece, Produto, TUnidade, PrecoVenda, Qtd, TotalVenda, L1,A1,L2,A2,L3,A3,L4,A4 ) SELECT " & CodigoNovoPedido & ", CodProdFornece, Produto, TUnidade, PrecoVenda, Qtd, TotalVenda, L1,A1,L2,A2,L3,A3,L4,A4 FROM TblSOrcamento WHERE IDOrcamento=" & Me!IdOrcamento & ";", dbFailOnError
              'Nz(DMax("[OrcDuplicado]", "[TblOrcamento]"), 0) + 1 & me.OrcamentoNumero & me.Idcliente
                Me.Requery
                Me.Refresh
            End If
        End If
        ' fim da duplicação
                DoCmd.RunCommand acCmdSaveRecord
              
        ' emissão de mensagem de sucesso e vai para o último registro, que será o  gerado na rotina acima.
        MsgBox "  Orçamento Duplicado com Sucesso !" & vbCrLf & _
                   "  PROVÁVEL..... numero de orçamento duplicado: " & x & " / " & Year(Date), vbInformation, Me.Caption
                  
 
                      DoCmd.GoToRecord , , acLast

End Sub

Olá Silvio, td bem?

Eu uso este código abaixo para efetuar baixa parcial, isto é quando valor não corresponde ele gera uma outra parcela renumerando a parcela acrescentando este complemento Ex;
Parcela 1/3 se dou baixa parcial me gera parcela 1/3-1 e assim por diante

Tente adaptar a sua necessidade..

Código:

Dim rst As DAO.Recordset
    If Me.ValorSaldo > 0 And Me.ValorSaldo <> Me.ValorDasParcelas Then
        MsgBox "O valor do Recebimento não corresponde ao valor do crédito. " & Chr(10) & "" _
        & "Será criado nova Parcela com a diferença !!!", vbCritical, "Atenção"
    
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblRecCartoesParc")

        rst.AddNew
        rst("CodRecCartoes") = Me.CodRecCartoes
    If InStr(Me.NºDeParcelas, "-") = 0 Then
        rst("NºDeParcelas") = Me.NºDeParcelas & "-1"
    Else
        rst("NºDeParcelas") = Mid(Me.NºDeParcelas, 1, InStr(Me.NºDeParcelas, "-")) & Mid(Me.NºDeParcelas, InStr(Me.NºDeParcelas, "-") + 1) + 1
    End If        
        rst.Update
    Set rst = Nothing        
    End If

Abraços

Celso, boa tarde.

Grato pela sua disposição em me responder tão brevemente, mas meu caro, não é bem isso.

Eu preciso gerar um numero automático, quando o orçamento tem a necessidade de ser duplicado para sofrer alterações de inclusão ou exclusão de itens.
Tenho essa necessidade, para evitar " dores de cabeças " futura com certos tipos de clientes.

Abraços.

Olá..

Entendi...,
Como você tem o código que faz a duplicação do orçamento a ideia foi você tentar aproveitar apenas a parte de incremento para gerar o novo número.

Se postar dados suficientes posso tentar de ajudar

Abraços

Boa noite, Silvio
Não entendi como tem o registo
Com orçamento e 5 duplicados fica assim:
01/2017
01/2017-001
01/2017-002
01/2017-003
01/2017-004
01/2017-005
é isto?

Alexandre, bom dia a si.

É isso mesmo, desse jeito e modo mesmo !

Resolvido....

Boa Noite!
E como nós, simples mortais, podemos também saber como foi corrigido?

Boa noite..

Claro que sim,

Private Sub bt_Inserir_Click()
If Not IsNull(Me.OrcDuplicado) Then
MsgBox "Esse Orçamento já tem um numero exclusivo " & vbCrLf & _
"Número Exclusivo: " & Me.OrcDuplicado, vbInformation, Me.Caption
Exit Sub
Else
Me.OrcDuplicado.Value = Me.IdOrcamento & "-" & Format(Date, "DDMMYY") & "/" & Format(Time, "HHMM")
End If

Bom dia
Muito obrigado!
Vou testar.

Boa tarde,
fnicolau, ao tempo que anda no fórum já devia saber que o titulo deve ser mantido para a sua finalidade e não para mensagem