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

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    avatar
    Chamon Consultoria
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 266
    Registrado : 31/08/2012

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  Chamon Consultoria 23/3/2017, 00:16

    Boa noite!

    Bd em Access 2010.

    O sistema possui o formulário Vendas com um subformulário onde são lançados os produtos, suas quantidades e valores.
    Como exemplo, diariamente são geradas várias vendas para um mesmo cliente e com diversos produtos.
    Nessas diversas vendas, o cliente acaba comprando os mesmos produtos (Produtos com mesmo código id).

    O sistema possui um comando em uma caixa de combinação, que permite agrupar (uma a uma) todas vendas de um mesmo cliente, em uma única venda. Porém, não agrupa os produtos que têm o mesmo id. Assim, se por exemplo, foram feitas dez vendas com o produto de Código id 001, o sistema gera no subformulário, dez linhas com as quantidades e valores de cada venda desse produto.
    O ideal seria se o sistema agrupasse as dez linhas desse produto em apenas uma, somando suas quantidades e valores.

    Como posso fazer isso?

    Desde já agradeço!
    CassioFabre
    CassioFabre
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 731
    Registrado : 18/01/2013

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  CassioFabre 23/3/2017, 12:14

    Bom dia,

    Isso seria viável pensando que o cliente compraria o mesmo produto, nas mesmas quantidades e pelo mesmo preço em todas as vezes. Mas caso isso não seja verdade, mesmo ainda é interessante implementar essa função?

    Abraço.
    avatar
    Chamon Consultoria
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 266
    Registrado : 31/08/2012

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  Chamon Consultoria 24/3/2017, 02:40

    Cassio,

    não sei se entendi bem sua pergunta... mas sim, a função precisa ser implementada de forma que acumule em uma única linha o somatório de todos os produtos que possuam o mesmo código (id) e com o mesmo valor unitário.

    Exemplo de como é:

    Cod Descrição Quantidade Vr Unit Total
    001 Produto A 100 1,00 100,00
    001 Produto A 200 1,00 200,00
    001 Produto A 150 1,00 150,00
    003 Produto C 900 2,00 1800,00


    Como deveria ficar aplicando a função:

    Cod Descrição Quantidade Vr Unit Total
    001 Produto A 450 1,00 450,00
    003 Produto C 900 2,00 1800,00


    Gostaria de pelo menos um exemplo de função que faça isso, para que eu possa adapta-la...


    Obrigado!


    CassioFabre
    CassioFabre
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 731
    Registrado : 18/01/2013

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  CassioFabre 24/3/2017, 11:27

    Bom dia,

    pra ficar mais fácil de implementar, poste a parte do bd que está relacionado com o seu problema.

    Abraço.
    avatar
    Chamon Consultoria
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 266
    Registrado : 31/08/2012

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  Chamon Consultoria 28/3/2017, 15:33

    Bom dia!



    Consegui um pequeno avanço. Ainda necessita de algum ajuste no código, mas não estou encontrando a falha...

    Sem a parte do código incluída em 28-03-2017, o sistema adiciona todos os itens do pedido selecionado à venda atual.

    Com a alteração no código o resultado foi:


    Atualiza a quantidade e valor apenas do primeiro item (se o código do produto for comum na venda atual e na selecionada para agrupar)

    Não atualiza os demais itens (se o código do produto também for comum na venda atual e na selecionada para agrupar)

    Não adiciona os demais itens que têm o código do produto diferente, permanecendo apenas os itens da venda atual. (quando a venda a ser agrupada possuir outros itens com o código do produto diferente dos existentes na venda atual)



    Código:
    Private Sub Agrupar_AfterUpdate()
        Dim txtCodPro As Integer
        Dim nCFOP
        Dim xPedidoAgrupado
      
        xPedidoAgrupado = Agrupar.Column(0)
        
        Beep
        Response = MsgBox("Confirma o agrupamento do pedido " & "" & xPedidoAgrupado & " ao pedido atual?", CM_SIMNAO + CM_ICONEINTERROGACAO, "Agrupar")
        If Response = IDNAO Then
            Exit Sub
        End If    
      
        Set dbs = CurrentDb
        strSql = "SELECT * FROM tbl_VendasItens WHERE NUMEROPEDIDO = " & "'" & xPedidoAgrupado & "'"
        Set rst = dbs.OpenRecordset(strSql)
                            
        Do While Not rst.EOF
            txtCodPro = rst("CODPRO")
            txtVarPro = DLookup("[ccVarPro]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtNomPro = DLookup("[ccNomPro]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtBarras = DLookup("[ccBarras]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtMedida = DLookup("[ccMedida]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            
            txtNCM = DLookup("[ccNCM]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtEstoque = DLookup("[ccEstoque]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtAliquotaIBPT = DLookup("[ccAliquotaIBPT]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtCST = DLookup("[ccCST]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtpIPI = DLookup("[ccIPI]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtIPICST = DLookup("[ccIPICST]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtPreçoCusto = DLookup("[ccPreçoCusto]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtPreçoVenda = rst("UNITARIO")
            txtTipoProduto = Busca("ccTipo", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtALIQUOTAICMS = Busca("ccICMSSAIDA", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtMVA = Busca("ccMVA", "viewProdutos", "[CODPRO]=" & txtCodPro & "")        
                
     
            nCFOP = txtCFOP      
          
                
            Set db = CurrentDb()
            Set RS = db.OpenRecordset("tbl_VendasItens")
    '--------------------------------------------------------------------------------------------------------------'Incluído para testar em 28-03-2017
            If DCount("CODPRO", "tbl_VendasItens", "CODPRO =" & txtCodPro & "") Then
        
            CurrentDb.Execute "Update tbl_VendasItens Set QUANTIDADE = QUANTIDADE +(" & rst("QUANTIDADE") & ") Where CODPRO =" & txtCodPro & " and NUMEROPEDIDO ='" & Me.txtNUMEROPEDIDO & "'"
            CurrentDb.Execute "Update tbl_VendasItens Set TOTAL =(QUANTIDADE * UNITARIO) Where CODPRO =" & txtCodPro & " and NUMEROPEDIDO ='" & Me.txtNUMEROPEDIDO & "'"
            
            LimpaCampos
            VendaSubConsulta.Requery
            CalculaSubTotal
            
            Exit Sub
            Else
    '------------------------------------------------------------------------------------------------------------------------------------------


            RS.AddNew
                RS("NUMEROPEDIDO") = txtNUMEROPEDIDO
                RS("NUMERONF") = txtNUMERONF
                RS("CODPRO") = txtCodPro
                RS("CODIGO") = txtVarPro
                RS("BARRAS") = txtBarras
                RS("DESCRICAO") = txtNomPro
                RS("MEDIDA") = txtMedida
                RS("NCM") = txtNCM
                RS("CST") = txtCST
                RS("CSOSN") = txtCSOSN
                RS("QUANTIDADE") = rst("QUANTIDADE")
                RS("CUSTO") = Format(txtPreçoCusto, "standard")
                RS("UNITARIO") = Format(txtPreçoVenda, "standard")
                txtSubTotal = Format((rst("QUANTIDADE") * txtPreçoVenda), "standard")
                RS("TOTAL") = Format(txtSubTotal, "##,##0.00")            
                RS("CFOP") = txtCFOP      
                              
                RS("ITEM") = nItem
                RS.Update
            rst.MoveNext
            
            nItem = Format(nItem + 1, "000")
    '------------------------------------------------------------------------------------------------------------------------------
            End If 'Incluído em 28-03-2017 para fechar: If DCount("CODPRO", "tbl_VendasItens", "CODPRO =" & txtCodPro & "") Then
    '------------------------------------------------------------------------------------------------------------------------------
        Loop      
        
        LimpaCampos
        VendaSubConsulta.Requery
        CalculaSubTotal    
      
        
    VoltaErro:

    Exit Sub

    erro:
        Beep
        MsgBox Error$, vbCritical, "Edição"
        Resume VoltaErro
    End Sub
    CassioFabre
    CassioFabre
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 731
    Registrado : 18/01/2013

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  CassioFabre 28/3/2017, 20:05

    Boa tarde,

    Apenas dessa forma não consigo visualizar o que pode estar acontecendo. Pra mim está tudo ok. Se possível, poste parte do bd que está tentando mexer.

    Abraço.
    avatar
    Chamon Consultoria
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 266
    Registrado : 31/08/2012

    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  Chamon Consultoria 22/5/2017, 02:29

    Segue código corrigido. As correções foram destacadas no código.

    No mais, obrigado pela atenção.

    Abraço.

    Código:
    Private Sub Agrupar_AfterUpdate()
        Dim txtCodPro As Integer
        Dim nCFOP
        Dim xPedidoAgrupado

        xPedidoAgrupado = Agrupar.Column(0)

        Beep
        Response = MsgBox("Confirma o agrupamento do pedido " & "" & xPedidoAgrupado & " ao pedido atual?", CM_SIMNAO + CM_ICONEINTERROGACAO, "Agrupar")
        If Response = IDNAO Then
            Exit Sub
        End If

        Set dbs = CurrentDb
        strSql = "SELECT * FROM tbl_VendasItens WHERE NUMEROPEDIDO = " & "'" & xPedidoAgrupado & "'"
        Set rst = dbs.OpenRecordset(strSql)

        '  Do While Not rst.EOF 'Desativado
        While (Not rst.EOF) 'Incluído
            txtCodPro = rst("CODPRO")
            txtVarPro = DLookup("[ccVarPro]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtNomPro = DLookup("[ccNomPro]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtBarras = DLookup("[ccBarras]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtMedida = DLookup("[ccMedida]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")

            txtNCM = DLookup("[ccNCM]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtEstoque = DLookup("[ccEstoque]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtAliquotaIBPT = DLookup("[ccAliquotaIBPT]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtCST = DLookup("[ccCST]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtpIPI = DLookup("[ccIPI]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtIPICST = DLookup("[ccIPICST]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtPreçoCusto = DLookup("[ccPreçoCusto]", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtPreçoVenda = rst("UNITARIO")
            txtTipoProduto = Busca("ccTipo", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtALIQUOTAICMS = Busca("ccICMSSAIDA", "viewProdutos", "[CODPRO]=" & txtCodPro & "")
            txtMVA = Busca("ccMVA", "viewProdutos", "[CODPRO]=" & txtCodPro & "")


            nCFOP = txtCFOP


            Set db = CurrentDb()
            Set RS = db.OpenRecordset("tbl_VendasItens")
            '--------------------------------------------------------------------------------------------------------------'Desativado
            '        If DCount("CODPRO", "tbl_VendasItens", "CODPRO =" & txtCodPro & "") Then

            '        CurrentDb.Execute "Update tbl_VendasItens Set QUANTIDADE = QUANTIDADE +(" & rst("QUANTIDADE") & ") Where CODPRO =" & txtCodPro & " and NUMEROPEDIDO ='" & Me.txtNUMEROPEDIDO & "'"
            '        CurrentDb.Execute "Update tbl_VendasItens Set TOTAL =(QUANTIDADE * UNITARIO) Where CODPRO =" & txtCodPro & " and NUMEROPEDIDO ='" & Me.txtNUMEROPEDIDO & "'"

            '        LimpaCampos
            '        VendaSubConsulta.Requery
            '        CalculaSubTotal

            '        Exit Sub
            '        Else
            '------------------------------------------------------------------------------------------------------------------------------------------
            If DCount("CODPRO", "tbl_VendasItens", "CODPRO =" & txtCodPro & " and NUMEROPEDIDO='" & Me.txtNUMEROPEDIDO & "'") Then    'Incluído

                CurrentDb.Execute "Update tbl_VendasItens Set QUANTIDADE = QUANTIDADE +(" & rst("QUANTIDADE") & ") Where CODPRO =" & txtCodPro & " and NUMEROPEDIDO ='" & Me.txtNUMEROPEDIDO & "'"
                CurrentDb.Execute "Update tbl_VendasItens Set TOTAL =(QUANTIDADE * UNITARIO) Where CODPRO =" & txtCodPro & " and NUMEROPEDIDO ='" & Me.txtNUMEROPEDIDO & "'"

            Else

                '-----------------------------------------------------------------------------------------------------------------------------------------

                RS.AddNew
                RS("NUMEROPEDIDO") = txtNUMEROPEDIDO
                RS("NUMERONF") = txtNUMERONF
                RS("CODPRO") = txtCodPro
                RS("CODIGO") = txtVarPro
                RS("BARRAS") = txtBarras
                RS("DESCRICAO") = txtNomPro
                RS("MEDIDA") = txtMedida
                RS("NCM") = txtNCM
                RS("CST") = txtCST
                RS("CSOSN") = txtCSOSN
                RS("QUANTIDADE") = rst("QUANTIDADE")
                RS("CUSTO") = Format(txtPreçoCusto, "standard")
                RS("UNITARIO") = Format(txtPreçoVenda, "standard")
                txtSubTotal = Format((rst("QUANTIDADE") * txtPreçoVenda), "standard")
                RS("TOTAL") = Format(txtSubTotal, "##,##0.00")
                RS("CFOP") = txtCFOP

                RS("ITEM") = nItem
                RS.Update
                rst.MoveNext

                nItem = Format(nItem + 1, "000")

            End If
            '  Loop 'Desativado

            rst.MoveNext    'Incluído

        Wend    'Incluído

        LimpaCampos
        VendaSubConsulta.Requery
        CalculaSubTotal


    VoltaErro:

        Exit Sub

    erro:
        Beep
        MsgBox Error$, vbCritical, "Edição"
        Resume VoltaErro
    End Sub

    Conteúdo patrocinado


    [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo Empty Re: [Resolvido]Agrupar Produtos que tenham o mesmo código em um formulário contínuo

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 8/11/2024, 01:06