MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

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

    avatar
    Ismael Silva
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 702
    Registrado : 11/12/2017

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

    Mensagem  Ismael Silva em 19/10/2020, 18:39

    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.
    Anexos
    [Resolvido]Consulta Gerar Lançamentos de Itens Automático de Acordo com a Função AttachmentExemplo 19-10-2020.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (41 Kb) Baixado 11 vez(es)
    avatar
    Ismael Silva
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 702
    Registrado : 11/12/2017

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

    Mensagem  Ismael Silva em 20/10/2020, 21:31

    Alguma ideia?
    avatar
    Ismael Silva
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 702
    Registrado : 11/12/2017

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

    Mensagem  Ismael Silva em 22/10/2020, 22:37

    Up
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7850
    Registrado : 05/11/2009

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

    Mensagem  Alexandre Neves em 23/10/2020, 10:54

    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


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    Ismael Silva
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 702
    Registrado : 11/12/2017

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

    Mensagem  Ismael Silva em 23/10/2020, 13:32

    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
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7850
    Registrado : 05/11/2009

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

    Mensagem  Alexandre Neves em 23/10/2020, 20:05

    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


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    Ismael Silva
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 702
    Registrado : 11/12/2017

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

    Mensagem  Ismael Silva em 24/10/2020, 01:40

    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.
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7850
    Registrado : 05/11/2009

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

    Mensagem  Alexandre Neves em 24/10/2020, 09:47

    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


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    Ismael Silva
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 702
    Registrado : 11/12/2017

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

    Mensagem  Ismael Silva em 24/10/2020, 14:41

    Obrigado!

      Data/hora atual: 20/1/2021, 19:48