MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

    Gerar código com base em data + digito

    avatar
    mparnaldo
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11
    Registrado : 04/08/2022

    Gerar código com base em data + digito Empty Gerar código com base em data + digito

    Mensagem  mparnaldo 27/5/2024, 16:42

    Boa tarde pessoal, estou com um problema que creio que para os especialistas em VBA seja fácil resolver, na verdade eu apelei para o tal ChatGPT e ele não conseguiu me ajudar kkk

    Tenho o formulário chamado frm_DesossarCarcacas_TF, é do tipo formulário contínuo, nesse formulário tem os seguintes campos:
    DATA_ABATE
    LOTE
    N_CARCACA
    SORTEADO que é do tipo sim ou não, quando esse campo estiver marcado preciso que quando o usuário clicar no botão btn_ConfirmaDesossa, dados que foram marcados, sejam copiados para a tabela tbl_Carcacas_Desossa_TF, porem nessa tabela tem um campo extra que se chama COD_DESOSSA e a mascara dele é no formato: DSS.ABT.99999999-9 onde:

    DSS.ABT- é fixo e 99999999-9 seria preenchido da seguinte forma:
    99999999 seria capturado do campo DATA_ABATE removendo os caracteres especiais, no caso as barras "/" e o ultimo 9 após o ifem, seria sequencial para a data, exemplo:

    Tem 5 registros com a data 19/05/2024 e o usuário selecionou 3 registros:
    DSS.ABT.19052024-1 em cada um dos registros que ele selecionou na primeira vez, depois ele selecionou mais dois em outro dia qualquer, dai ficaria DSS.ABT-19052024-2 e assim sucessivamente...

    O código abaixo digamos que está funcionando em partes, ele transfere os registros selecionados para a tabela tbl_Carcacas_Desossa_TF, porem na hora que gerar o COD_DESOSSA é que acontece o problema...

    Private Sub btn_ConfirmaDesossa_Click()
    Dim db As DAO.Database
    Dim rsSource As DAO.Recordset
    Dim rsDestination As DAO.Recordset
    Dim strDataDesossa As String
    Dim strCOD_DESOSSA As String
    Dim intSequence As Integer
    Dim dicSequence As Object
    Dim bSelected As Boolean

    Set db = CurrentDb()

    ' Forçar a gravação de todos os registros pendentes
    If Me.Dirty Then
    Me.Dirty = False
    End If

    ' Utilizar o recordset do formulário contínuo diretamente
    Set rsSource = Me.RecordsetClone

    ' Verificar se o campo DESOSSADO existe no recordset
    If Not FieldExists(rsSource, "DESOSSADO") Then
    MsgBox "O campo 'DESOSSADO' não foi encontrado no recordset.", vbCritical
    Exit Sub
    End If

    ' Solicitar a data de desossa ao usuário
    strDataDesossa = InputBox("Informe a data de desossa (DD/MM/AAAA):", "Data de Desossa")

    ' Validar a entrada do usuário
    If Not IsValidDate(strDataDesossa) Then
    MsgBox "Data inválida!", vbCritical
    Exit Sub
    End If

    ' Inicializar a variável de controle
    bSelected = False

    ' Inicializar o dicionário para armazenar a sequência por data
    Set dicSequence = CreateObject("Scripting.Dictionary")

    ' Percorrer os registros no recordset do formulário
    rsSource.MoveFirst
    Do While Not rsSource.EOF
    ' Verifica se o registro está marcado
    If rsSource!DESOSSADO = True Then
    ' Indica que pelo menos um registro foi selecionado
    bSelected = True

    ' Obtém a data de abate e remove as barras
    Dim strDataAbate As String
    strDataAbate = Format(rsSource!DATA_ABATE, "DDMMYYYY")

    ' Verifica se a sequência já foi inicializada para essa data de desossa
    If Not dicSequence.Exists(strDataDesossa) Then
    ' Se a sequência não foi inicializada para essa data, inicializa com 1
    dicSequence(strDataDesossa) = 1
    End If

    ' Obtém a sequência para essa data
    intSequence = dicSequence(strDataDesossa)

    ' Monta o COD_DESOSSA
    strCOD_DESOSSA = "DSS.ABT-" & strDataAbate & "-" & intSequence

    ' Abre a tabela de destino para inserção
    Set rsDestination = db.OpenRecordset("tbl_Carcacas_Desossa_TF", dbOpenDynaset)
    rsDestination.AddNew
    rsDestination!DATA_ABATE = rsSource!DATA_ABATE
    rsDestination!LOTE = rsSource!LOTE
    rsDestination!N_CARCACA = rsSource!N_CARCACA
    rsDestination!COD_DESOSSA = strCOD_DESOSSA
    rsDestination!DATA_DESOSSA = DateValue(strDataDesossa) ' Armazena a data de desossa
    rsDestination.Update
    rsDestination.Close

    ' Incrementa a sequência para essa data
    dicSequence(strDataDesossa) = intSequence + 1
    End If

    rsSource.MoveNext
    Loop

    ' Verificar se pelo menos um registro foi selecionado
    If Not bSelected Then
    MsgBox "Nenhum registro foi selecionado.", vbExclamation
    Exit Sub
    End If

    rsSource.Close
    Set rsSource = Nothing
    Set rsDestination = Nothing
    Set db = Nothing
    Set dicSequence = Nothing

    MsgBox "Registros transferidos com sucesso!", vbInformation
    End Sub

    Private Function IsValidDate(ByVal strDate As String) As Boolean
    On Error Resume Next
    IsValidDate = IsDate(strDate)
    On Error GoTo 0
    End Function

    ' Função para verificar se um campo existe no recordset
    Private Function FieldExists(rs As DAO.Recordset, fieldName As String) As Boolean
    Dim i As Integer
    FieldExists = False
    For i = 0 To rs.Fields.Count - 1
    If rs.Fields(i).Name = fieldName Then
    FieldExists = True
    Exit For
    End If
    Next i
    End Function


    O problema se dá no campo COD_DESOSSA da tabela tbl_Carcacas_Desossa_TF, pois está sendo gerado o código de forma errada...
    Vou tentar explicar, uma DATA_ABATE pode ter uma ou várias DATA_DESOSSA (data solicitada ao usuário após clicar no botão), dentro de uma DATA_ABATE pode ter vários registros, de vários lotes, dessa forma o usuário vai selecionar os lotes que vão ser desossados em uma determinada data (DATA_DESOSSA), quando o usuário seleciona os lotes à serem desossados, em uma mesma data, o COD_DESOSSA deverá receber o mesmo digito no final, se ele selecionar 3 lotes, 4 lotes, seja lá quantos lotes forem, todos os registros transportados deverão receber o mesmo digito no final, apenas quando a DATA_DESOSSA for outra para a mesma DATA_ABATE o COD_DESOSSA deverá receber outro digito no final (de forma sequencial)

    Fiz alguns teste, e está ficando da seguinte forma:

    Como ficou na tabela:
    COD_DESOSSA DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 711
    DSS.ABT-26052024-2 26/05/2024 27/05/2024 7 796
    DSS.ABT-26052024-3 26/05/2024 27/05/2024 7 806

    Como era esperado:
    COD_DESOSSA DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 711
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 796
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 806

    Vejam que foram selecionados 3 registros da mesma DATA_ABATE e foi informado a DATA_DESOSSA, todos deveriam ter recebido o digito 1 por se tratar da mesma desossa, e o que aconteceu foi que todos receberam dígitos sequenciais, só vai acontecer isso se em outra ocasião o usuário informar outra DATA_DESOSSA para outros lotes da mesma DATA_ABATE dai sim iria entrar um novo digito para esses registros... Vou tentar exemplificar:

    COD_DESOSSA DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 711
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 796
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 806

    O usuário foi e selecionou mais 2 lotes da mesma DATA-ABATE porem informou a DATA_DESOSSA 30/05/2024, como deveria ficar:
    COD_DESOSSA DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 711
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 796
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 806
    DSS.ABT-26052024-2 26/05/2024 30/05/2024 9 1011
    DSS.ABT-26052024-2 26/05/2024 30/05/2024 10 1236

    Reparem que apenas os dois registros irão receber o digito 2 por se tratar da segunda desossa do abate do dia 26/05/2024

    Se alguém puder dar uma olhada ficaria extremamente grato...
    Anexos
    Gerar código com base em data + digito AttachmentCONDIF V-27.05.2024.002.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (57 Kb) Baixado 10 vez(es)
    scandinavo
    scandinavo
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1059
    Registrado : 11/11/2009

    Gerar código com base em data + digito Empty Re: Gerar código com base em data + digito

    Mensagem  scandinavo 30/5/2024, 01:45

    Ola
    para este erro

    Como ficou na tabela:
    COD_DESOSSA DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 711
    DSS.ABT-26052024-2 26/05/2024 27/05/2024 7 796
    DSS.ABT-26052024-3 26/05/2024 27/05/2024 7 806

    Como era esperado:
    COD_DESOSSA DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 711
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 796
    DSS.ABT-26052024-1 26/05/2024 27/05/2024 7 806

    Basta comentar esta linha

    ' Incrementa a sequência para essa data
    dicSequence(strDataDesossa) = intSequence + 1
    avatar
    mparnaldo
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11
    Registrado : 04/08/2022

    Gerar código com base em data + digito Empty Re: Gerar código com base em data + digito

    Mensagem  mparnaldo 3/6/2024, 11:56

    Bom dia, tentei isso e funcionou em partes...

    Ficou dessa forma:

    COD_DESOSSA        DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 28/05/2024 1 36
    DSS.ABT-26052024-1 26/05/2024 28/05/2024 2 74
    DSS.ABT-26052024-1 26/05/2024 29/05/2024 7 392
    DSS.ABT-26052024-1 26/05/2024 29/05/2024 8 455
    DSS.ABT-26052024-1 26/05/2024 29/05/2024 11 630

    Como deveria ficar:

    COD_DESOSSA        DATA_ABATE DATA_DESOSSA LOTE N_CARCACA
    DSS.ABT-26052024-1 26/05/2024 28/05/2024 1 36
    DSS.ABT-26052024-1 26/05/2024 28/05/2024 2 74
    DSS.ABT-26052024-2 26/05/2024 29/05/2024 7 392
    DSS.ABT-26052024-2 26/05/2024 29/05/2024 8 455
    DSS.ABT-26052024-2 26/05/2024 29/05/2024 11 630


    Repare que a data de desossa mudou para 26/05/2024 porém o abate ainda é o mesmo, o que caracteriza nova desossa, daí sim deveria mudar o dígito para 2 ou 3 ou 4 se tivesse várias desossas para o mesmo abate...
    scandinavo
    scandinavo
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1059
    Registrado : 11/11/2009

    Gerar código com base em data + digito Empty Re: Gerar código com base em data + digito

    Mensagem  scandinavo 5/6/2024, 02:20

    Substitua o seu codigo por este, faça o teste mas ainda falta fazer alguns ajustes



    Dim db As DAO.Database
    Dim rsSource As DAO.Recordset
    Dim rsDestination As DAO.Recordset
    Dim strDataDesossa As String
    Dim strCOD_DESOSSA As String
    Dim intSequence As Integer
    Dim dicSequence As Object
    Dim bSelected As Boolean

    Set db = CurrentDb()

    ' Forçar a gravação de todos os registros pendentes
    If Me.Dirty Then
    Me.Dirty = False
    End If

    ' Utilizar o recordset do formulário contínuo diretamente
    Set rsSource = Me.RecordsetClone

    ' Verificar se o campo DESOSSADO existe no recordset
    If Not FieldExists(rsSource, "DESOSSADO") Then
    MsgBox "O campo 'DESOSSADO' não foi encontrado no recordset.", vbCritical
    Exit Sub
    End If

    ' Solicitar a data de desossa ao usuário
    strDataDesossa = InputBox("Informe a data de desossa (DD/MM/AAAA):", "Data de Desossa")

    ' Validar a entrada do usuário
    If Not IsValidDate(strDataDesossa) Then
    MsgBox "Data inválida!", vbCritical
    Exit Sub
    End If

    ' Inicializar a variável de controle
    bSelected = False

    ' Inicializar o dicionário para armazenar a sequência por data
    Set dicSequence = CreateObject("Scripting.Dictionary")
    '''''''''''''''''''''''''''''''''''
    ' Verifica se a sequência já foi inicializada para essa data de abate
    If DCount("DATA_ABATE", "tbl_Carcacas_Desossa_TF", "DATA_ABATE = #" & DATA_ABATE & "#") = 0 Then

    dicSequence(strDataDesossa) = 1
    Else
    dicSequence(strDataDesossa) = 2 'ainda falta fazer ajustes no codigo para o contador
    End If
    '''''''''''''''''''''''''''''''''

    ' Percorrer os registros no recordset do formulário
    rsSource.MoveFirst
    Do While Not rsSource.EOF
    ' Verifica se o registro está marcado
    If rsSource!DESOSSADO = True Then
    ' Indica que pelo menos um registro foi selecionado
    bSelected = True

    ' Obtém a data de abate e remove as barras
    Dim strDataAbate As String
    Dim datacomparacao As Date
    strDataAbate = Format(rsSource!DATA_ABATE, "DDMMYYYY")
    datacomparacao = rsSource!DATA_ABATE
    ' Verifica se a sequência já foi inicializada para essa data de desossa
    ' If Not dicSequence.Exists(strDataDesossa) Then
    ' ' Se a sequência não foi inicializada para essa data, inicializa com 1
    ' dicSequence(strDataDesossa) = 1
    'End If

    ' Obtém a sequência para essa data
    intSequence = dicSequence(strDataDesossa)

    ' Monta o COD_DESOSSA
    strCOD_DESOSSA = "DSS.ABT-" & strDataAbate & "-" & intSequence

    ' Abre a tabela de destino para inserção
    Set rsDestination = db.OpenRecordset("tbl_Carcacas_Desossa_TF", dbOpenDynaset)
    rsDestination.AddNew
    rsDestination!DATA_ABATE = rsSource!DATA_ABATE
    rsDestination!LOTE = rsSource!LOTE
    rsDestination!N_CARCACA = rsSource!N_CARCACA
    rsDestination!COD_DESOSSA = strCOD_DESOSSA
    rsDestination!DATA_DESOSSA = DateValue(strDataDesossa) ' Armazena a data de desossa
    rsDestination.Update
    rsDestination.Close

    ' Incrementa a sequência para essa data
    'dicSequence(strDataDesossa) = intSequence + 1
    End If

    rsSource.MoveNext
    Loop

    ' Verificar se pelo menos um registro foi selecionado
    If Not bSelected Then
    MsgBox "Nenhum registro foi selecionado.", vbExclamation
    Exit Sub
    End If

    rsSource.Close
    Set rsSource = Nothing
    Set rsDestination = Nothing
    Set db = Nothing
    Set dicSequence = Nothing

    MsgBox "Registros transferidos com sucesso!", vbInformation
    Me.Form.Requery 'atualiza o formulario para retirar os que ja foram desossados'Scandinavo 04/06/24

    Conteúdo patrocinado


    Gerar código com base em data + digito Empty Re: Gerar código com base em data + digito

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 7/12/2024, 23:12