[Resolvido]Consulta Gerar Lançamentos de Itens Automático de Acordo com a Função

Boa tarde,

Estou tentando um jeito de gerar lançamentos automático, explico da seguinte forma:

Todo o mês eu preciso entregar luvas entre outros materiais para os meus funcionários(Assistentes), são itens padrão, que todo início de mês eu vou entregar, então para não precisar lançar um por um, então pensei em criar uma consulta(que não consegui acertar), que ao selecionar uma determinada data,(Frm_Acrescentar) que é a que eu vou entregar os itens, selecionando a função e os itens, e ao clicar no botão lançar, que já lance automático na Tbl_Saida_Det, de forma que tivesse uma relação com a tbl_saida, não sei se isso é possível.

Espero ter me feito entender.

Obrigado.

Alguma ideia?

Up

Bom dia
Quer lançar para todos da tabela funcionarios?
Se não, tenha uma forma de indicar qual funcionario vai receber o quê
Depois, é criar código para acrescentar registos na tabela detalhe de acordo com as entregas a cada um

Bom dia Alexandre,

A ideia é lançar para todos os funcionários que tem a função de Assistente, conforme mencionei, aí no Frm_Acrescentar, a ideia seria apenas selecionar a data que estou entregando, a função que é assistente, e o item que estou entregando, mas eu não consegui achar uma maneira de fazer isso

Boa noite
Código para o botão

Código:

Private Sub Btn_Lancar_Click()
    '--------------------------------------------------------------'
    '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
    '    utilize o código livremente mas mantenha os créditos    '
    '--------------------------------------------------------------'
    Dim Rst1 As DAO.Recordset, Rst2 As DAO.Recordset, RstSaida As DAO.Recordset, RstSaidaDet As DAO.Recordset, Id As Long, Cont As Integer
   
    If Len("" & Data_Lanca) > 0 And Len("" & Funcao) > 0 And Len("" & Item) > 0 Then
        Set RstSaida = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Saida")
        Set RstSaidaDet = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Saida_Det")
        Set Rst1 = CurrentDb.OpenRecordset("SELECT DISTINCT Empresa, Cidade FROM Tbl_Funcionarios WHERE Funcao='" & Funcao & "'")
        Do Until Rst1.EOF
            RstSaida.AddNew
            RstSaida("Data_Saida") = Data_Lanca
            RstSaida("Empresa") = Rst1("Empresa")
            RstSaida("Cidade") = Rst1("Cidade")
            Id = RstSaida("Id")
            RstSaida.Update
            Set Rst2 = CurrentDb.OpenRecordset("SELECT Nome, Empresa, Cidade FROM Tbl_Funcionarios WHERE Cidade='" & Rst1("Cidade") & "' and Funcao='" & Funcao & "'")
            Do Until Rst2.EOF
                RstSaidaDet.AddNew
                RstSaidaDet("Cod") = Id
                RstSaidaDet("Data_Saida") = Data_Lanca
                RstSaidaDet("Empresa") = Rst2("Empresa")
                RstSaidaDet("Funcionario") = Rst2("Nome")
                RstSaidaDet("Funcao") = "'" & Funcao & "'"
                RstSaidaDet("Descritivo") = "'" & Item & "'"
                RstSaidaDet("Qtde") = 2
                RstSaidaDet("Cidade_Det") = Rst2("Cidade")
                RstSaidaDet.Update
                Cont = Cont + 1
                Rst2.MoveNext
            Loop
            Rst1.MoveNext
        Loop
        MsgBox "Acrescentados " & Cont & " registos."
    Else
        MsgBox "Não foram efectuados lançamentos por falha de preenchimento."
    End If
End Sub

Boa noite Alexandre,

Antes de mais nada, muito obrigado, era exatamente isso que eu precisava, eu nunca iria conseguir resolver isso sozinho.
E se não for abusar da sua boa vontade, poderia comentar algumas linhas, dizendo o que cada linha faz, isso pra mim conseguir entender melhor, pois sempre tento entender o código e não apenas copiar e colar.

Meu muito obrigado mais uma vez.

Bom dia

Código:

Private Sub Btn_Lancar_Click()
    '--------------------------------------------------------------'
    '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
    '    utilize o código livremente mas mantenha os créditos    '
    '--------------------------------------------------------------'
    Dim Rst1 As DAO.Recordset, Rst2 As DAO.Recordset, RstSaida As DAO.Recordset, RstSaidaDet As DAO.Recordset, Id As Long, Cont As Integer
   
    If Len("" & Data_Lanca) > 0 And Len("" & Funcao) > 0 And Len("" & Item) > 0 Then 'verifica se todos os controlos estão preenchidos
        Set RstSaida = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Saida") 'carrega tabela
        Set RstSaidaDet = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Saida_Det") 'carrega tabela
        Set Rst1 = CurrentDb.OpenRecordset("SELECT DISTINCT Empresa, Cidade FROM Tbl_Funcionarios WHERE Funcao='" & Funcao & "'") 'carrega tabela com Empresa e Cidade dos funcionários com a função escolhida
        Do Until Rst1.EOF 'percorre a tabela
            RstSaida.AddNew 'acrescenta novo registo na tabela principal
            RstSaida("Data_Saida") = Data_Lanca
            RstSaida("Empresa") = Rst1("Empresa")
            RstSaida("Cidade") = Rst1("Cidade")
            Id = RstSaida("Id") 'guarda id para tabela SaidaDet
            RstSaida.UPDATE 'grava registo
            Set Rst2 = CurrentDb.OpenRecordset("SELECT Nome, Empresa, Cidade FROM Tbl_Funcionarios WHERE Cidade='" & Rst1("Cidade") & "' and Funcao='" & Funcao & "'") 'carrega tabela com funcionários com a função escolhida da cidade registada na tabela principal
            Do Until Rst2.EOF 'percorre a tabela
                RstSaidaDet.AddNew 'acrescenta novo registo na tabela detalhe
                RstSaidaDet("Cod") = Id
                RstSaidaDet("Data_Saida") = Data_Lanca
                RstSaidaDet("Empresa") = Rst2("Empresa")
                RstSaidaDet("Funcionario") = Rst2("Nome")
                RstSaidaDet("Funcao") = "'" & Funcao & "'"
                RstSaidaDet("Descritivo") = "'" & Item & "'"
                RstSaidaDet("Qtde") = 2
                RstSaidaDet("Cidade_Det") = Rst2("Cidade")
                RstSaidaDet.UPDATE 'grava registo
                Cont = Cont + 1
                Rst2.MoveNext
            Loop
            Rst1.MoveNext
        Loop
        MsgBox "Acrescentados " & Cont & " registos."
    Else
        MsgBox "Não foram efectuados lançamentos por falha de preenchimento."
    End If
End Sub

Obrigado!