[Resolvido]Inserir produto da pesquisa em um sub-formulário de vendas

Boa tarde,

Tenho um formulário de vendas e dentro dele um sub-formulário onde vai os itens da venda, tais como Descrição do Produto, Valor Unitário, Quantidade e o Valor Total....
Tem um botão de pesquisa de produtos cadastrados que abre a consulta de todos os produtos...

Essa pesquisa de produtos cadastrados possuí um botão de "ADD" que tem o seguinte código ao clicar 2 vezes:

Private Sub Abrir_DblClick(Cancel As Integer)

Dim rs As Object
Dim stDocName As String
Dim lngIdRegistro As Long
Dim Msg As String
On Error GoTo 1

Dim lngCodVenda As Long

If Nz(Forms!frm_PesquisaProdVendas!Quantidade, 0) <= 0 Then
MsgBox "Atenção; A Quantidade Deve Ser Maior Que Zero... Corrija Por Favor!", , "Atenção!"
Exit Sub
End If

If Forms!frm_PesquisaProdVendas.Form.OpenArgs = "AberturaVenda" Then

lngCodVenda = Forms!frm_Vendas!CodVenda

'Gravo o registro no banco
DoCmd.SetWarnings False

Sel2 = "SELECT * from tbl_VendasDet"
Set rst2 = CurrentDb.OpenRecordset(Sel2)

rst2.AddNew
rst2![CodigoVendas] = lngCodVenda
rst2![Produto] = Me.Descrição
rst2![Unidade] = Me.Unidade
rst2![ValorUnit] = Round(Nz(Me.Valor_Unitário, 0), 4)
rst2![Quantidade] = Round(Nz(Forms!PesquisaProdVendas!Quantidade, 0), 2)
'rst2![DataCadastro] = Format(Now, "dd/mm/yyyy")
rst2.Update
rst2.Close

UltimoCodigo = Nz(DMax("CodTabDet", "tbl_VendasDet"), 0)

'Atualizo o subformulario trazendo o registro novo
Forms!frm_Vendas!frm_VendasSub.Requery


End If


DoCmd.SetWarnings True


Exit_1:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub

1 a:
DoCmd.Hourglass False
DoCmd.Echo True
Msg = "Erro # " & Str(Err.Number) _
& vbNewLine & "Descrição: " & Err.Description _
& vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
MsgBox Msg, vbExclamation, "Atenção"
Resume Exit_1

End Sub


A questão é a seguinte:
Não esta funcionando... Não da erro nem adiciona o produto ao sub-formulário de vendas...

Onde posso estar errando ?

Aguardo.
Grato.

Olá,

O recordset "rst2" não estava declarado.
Copie e cole o código abaixo:

Código:


Private Sub Abrir_DblClick(Cancel As Integer)
On Error GoTo trata_erro

'-- by Alexandre Fim -------------------------------------------------------------------
'-- Dim rs As Object -> variavel de recorset não está no contexto do procedimento
Dim rst2            As DAO.Recordset
'---------------------------------------------------------------------------------------
Dim stDocName      As String
Dim lngIdRegistro  As Long
Dim Msg            As String
Dim lngCodVenda    As Long

    If Nz(Forms!frm_PesquisaProdVendas!Quantidade, 0) <= 0 Then
        MsgBox "Atenção; A Quantidade Deve Ser Maior Que Zero... Corrija Por Favor!", , "Atenção!"
        Exit Sub
    End If
   
    If Forms!frm_PesquisaProdVendas.Form.OpenArgs = "AberturaVenda" Then
   
        lngCodVenda = Forms!frm_Vendas!CodVenda
   
        'Gravo o registro no banco
        DoCmd.SetWarnings False
   
        Sel2 = "SELECT * from tbl_VendasDet"
        Set rst2 = CurrentDb.OpenRecordset(Sel2)
   
        rst2.AddNew
        rst2![CodigoVendas] = lngCodVenda
        rst2![Produto] = Me.Descrição
        rst2![Unidade] = Me.Unidade
        rst2![ValorUnit] = Round(Nz(Me.Valor_Unitário, 0), 4)
        rst2![Quantidade] = Round(Nz(Forms!PesquisaProdVendas!Quantidade, 0), 2)
        'rst2![DataCadastro] = Format(Now, "dd/mm/yyyy")
        rst2.Update
        rst2.Close
        '-- Limpa rs da memoria -----------------
        Set rst2 = Nothing
        '-----------------------------------------
   
        UltimoCodigo = Nz(DMax("CodTabDet", "tbl_VendasDet"), 0)
   
        'Atualizo o subformulario trazendo o registro novo
        Forms!frm_Vendas!frm_VendasSub.Requery
    End If
   
   
    DoCmd.SetWarnings True
   
    DoCmd.Hourglass False
    DoCmd.Echo True
    Exit Sub
   
trata_erro:
    DoCmd.Hourglass False
    DoCmd.Echo True
    Msg = "Erro # " & Str(Err.Number) _
        & vbNewLine & "Descrição: " & Err.Description _
        & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
    MsgBox Msg, vbExclamation, "Atenção"
    Exit Sub

End Sub



Faça o teste e veja se funciona.

Att,

Alexandre Fim

Boa noite Alexandre,

Agradeço sua resposta e disposição em me ajudar.

Coloquei o código mais ainda permanece da mesma forma... não adiciona o produto selecionado ao sub-formulário de vendas e também não da erro de execução no código.

Não entendo o que pode estar ocorrendo !

Alguma outra dica ?

Att,

Disponibilize uma copia do seu bd, somente objetos(forms/consultas/tabelas/modulos e etc) envolvidos no problema para análise e solução.

Att,

Alexandre Fim

Alexandre,

Já separei o DB otimizado, apenas com os objetos(forms/consultas/tabelas/modulos e etc) envolvidos no problema...
Como posso enviar ele ? pois o tamanho está em 7mb.

E-mail ou algo parecido ?


Aguardo.
Grato.

Oi Alexandre,

Posso disponibilizar também um link para o download do DB... Pode ser assim ?

Aguardo,
Obrigado.

Bom dia,

Segue DB... O mesmo esta no OneDrive compartilhado.

https://1drv.ms/u/s!AneHadIpuEflgtMGY1uQN8sfheQBZA?e=EPrYmO

Shift para edição.

Grato.

Bom dia bobperes,
Vou verificar.
Valeu

Bom dia Alexandre,

Opa, agradeço...
Fico no aguardo.

Muito grato.

Bom dia Alexandre,

Desculpa incomodar... Você chegou a dar uma olhada no DB para ver o que ocorre ?
Eu tentei ver aqui mais ainda não achei o problema...

Qualquer novidade me avisa.
Muito grato.

Ótimo final de semana e boa Páscoa.

Att,

Bom dia,

Alguém consegue me ajudar com essa questão do tópico
Eu já procurei em varias partes do código e sinceramente não consegui ainda entender o que ocorre...

Se alguém conseguir me ajudar ficarei muito grato


Att,
Peres

Bom dia meu amigo!

Baixei teu arquivo, porém está apresentando erros ao abrir o formulário mostrando que alguns objetos não estão presente. É importante que poste o arquivo com todos objetos envolvidos para que possamos entender como o erro acontece e assim trazer a possível solução. Se possível reveja e teste o arquivo e poste novamente. Abraço!

Boa noite Adriano.

Grato por sua interação na questão.
Conforme mencionado nas mensagens anteriores, tem que abrir o arquivo com o shift para acessar o banco corretamente e sem apresentar erros.

Grato.

Att,
Peres

Pois é desta forma mesmo que estou abrindo o banco.

Boa tarde,

Adriano, habilite essas referências abaixo no módulo VBA.
É bem provável que os erros estejam sendo gerados por falta das referências...




Ao abrir o formulário de vendas provavelmente dará um erro do sub-formulario de contas a receber... desconsidere...
esse sub-formulário não faz parte do problema.


Qualquer coisa me avisa.

Grato.

Fiz duas pequenas mudanças no código. Veja se funciona:

Código:



    Dim rs As Object
    Dim stDocName As String
    Dim lngIdRegistro As Long
    Dim Msg As String
    On Error GoTo 1

    Dim lngCodVenda As Long
    Dim Sel2 As String
    Dim rst2 As Recordset
    Dim UltimoCodigo As Long

    If Nz(Forms!frm_PesquisaProdVendas!Quantidade, 0) <= 0 Then
        MsgBox "Atenção; A Quantidade Deve Ser Maior Que Zero... Corrija Por Favor!", , "Atenção!"
        Exit Sub
    End If

    If Forms!frm_PesquisaProdVendas.Form.OpenArgs = "AberturaVenda" Then

        lngCodVenda = Forms!frm_Vendas!CodVenda

        'Gravo o registro no banco
        DoCmd.SetWarnings False

        Sel2 = "SELECT * from tbl_VendasDet"
        Set rst2 = CurrentDb.OpenRecordset(Sel2)

        rst2.AddNew
        rst2![CodigoVendas] = lngCodVenda
        rst2![Produto] = Me.Descrição
        rst2![Unidade] = Me.Unidade
        rst2![ValorUnit] = Round(Nz(Me.Valor_Unitário, 0), 4)
        rst2![Quantidade] = Round(Nz(Forms!PesquisaProdVendas!Quantidade, 0), 2)
        'rst2![DataCadastro] = Format(Now, "dd/mm/yyyy")
        rst2.Update
        rst2.Close

        UltimoCodigo = Nz(DMax("CodTabDet", "tbl_VendasDet"), 0)

        'Atualizo o subformulario trazendo o registro novo
        Forms!frm_Vendas!frm_VendasSub.Requery

    End If

    DoCmd.SetWarnings True

Exit_1:
    DoCmd.Hourglass False
    DoCmd.Echo True
    Exit Sub

1:
    DoCmd.Hourglass False
    DoCmd.Echo True
    Msg = "Erro # " & Str(Err.Number) _
        & vbNewLine & "Descrição: " & Err.Description _
        & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
    MsgBox Msg, vbExclamation, "Atenção"
    Resume Exit_1




Boa tarde Adriano,

Não funcionou não.
Continua da mesma forma... dou duplo click e nada acontece, nem mesmo um erro ocorre para chegar ao problema..

Sei lá !


Já venho quebrando a cabeça com isso a vários dias e não acho o problema...

Bobperes,

Baixei seu exemplo e não abre o sistema, porem, aparece esta mensagem:


Att,

Alexandre Fim

Boa noite Alexandre,

Perdoa... estive alterando algumas coisa em minha máquina e acho que acabei mexendo no OneDriver sem querer...
Segue o link:


https://1drv.ms/u/s!AneHadIpuEflgtMGY1uQN8sfheQBZA?e=w2E6Ma



Qualquer coisa me avisa.

Grato.

Boa tarde Fim,

Deu certo o arquivo com o link novo ?
Abriu direitinho ?


Aguardo.
Grato.

Att,
Peres

Boa tarde amigos.

Alguém ajuda por favor !


Grato.

Ninguém ???

Boa noite,

Resolvi o problema dessa questão...
Refiz a estrutura do código do zero e deu certo !!!

Aos interessados nessa questão segue o código para ajudar.

******************************************************************************

Dim rs As Object
Dim stDocName As String
Dim lngIdRegistro As Long
Dim Msg As String
On Error GoTo 1

Dim lngCodVenda As Long

If Nz(Forms!frm_PesquisaProdVendas!Quantidade, 0) <= 0 Then
MsgBox "Atenção; A Quantidade Deve Ser Maior Que Zero... Corrija Por Favor!", , "Atenção!"
Exit Sub
End If

If Forms!frm_PesquisaProdVendas.Form.OpenArgs = "AberturaProdutosVendas" Then

lngCodVenda = Forms!frm_Vendas!CodVenda

'Gravo o registro no banco
DoCmd.SetWarnings False

Sel2 = "SELECT * from tbl_VendasDet"
Set rst2 = CurrentDb.OpenRecordset(Sel2)

rst2.AddNew
rst2![CodigoVendas] = lngCodVenda
rst2![Descricao] = Me.Descricao
rst2![Produto] = Me.Codigo
rst2![ValorUnit] = Round(Nz(Me.Valor_Unitário, 0), 4)
rst2![Quantidade] = Round(Nz(Forms!frm_PesquisaProdVendas!Quantidade, 0), 2)
rst2.Update
rst2.Close

'-- Limpa rs da memoria -----------------
Set rst2 = Nothing
'-----------------------------------------

UltimoCodigo = Nz(DMax("CodTabDet", "tbl_VendasDet"), 0)

'Atualizo o subformulario trazendo o registro novo
Forms!frm_Vendas!frm_VendasSub.Requery

End If


DoCmd.SetWarnings True

Exit_1:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub

1 a:
DoCmd.Hourglass False
DoCmd.Echo True
Msg = "Erro # " & Str(Err.Number) _
& vbNewLine & "Descrição: " & Err.Description _
& vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
MsgBox Msg, vbExclamation, "Atenção"
Resume Exit_1