Início
mparnaldo 27/5/2024, 16:42Boa 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...
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
CONDIF V-27.05.2024.002.zip - Você não tem permissão para fazer download dos arquivos anexados.
- (57 Kb) Baixado 9 vez(es)
