[Resolvido]Dificuldade com o "Economato" do J.Paulo

Boa noite, amigos do Fórum.
Estou tentando adaptar o Aplicatvo que o JPaulo disponibilizou, mas estou encontrando uma dificuldade. É que ao dar entrega em uma quantidade grande de produtos de um mesmo item, digamos 20.000, o código não aceita. Não dá mensagem de erro, mas não acresce o valor ao estoque. Na Tabela correspondente o Tamanho do campo de Estoque estava "inteiro" e Formato "Numero Geral". Mudei para "Inteiro Longo" e também testei "Duplo", mas deu o mesmo problema. O Código que está no botão é:
Private Sub cmdSaída_Click()
'Reduz a quantidade do produto no stock
Dim intQuantidade As Integer
Dim lngCódigoDoProduto As Long
Dim Cancel As Integer
On Error GoTo Tratamento

intQuantidade = txtQuantidade
lngCódigoDoProduto = ListaProdutos

If intQuantidade > txtStock.Value Then

MsgBox "Não tem quantidade em Estoque Suficiente para efetuar o movimento.", vbExclamation, "Controle de estoque"
Cancel = True
Me.txtQuantidade.SetFocus
Me.txtQuantidade.Value = 1

Exit Sub
End If
If MsgBox("Deseja reduzir " & intQuantidade & " unidade(s) do Estoque ?", vbQuestion + vbYesNo, "Controle de Estoque") = vbYes Then
   intQuantidade = txtQuantidade
   modProduto.AcertaStock lngCódigoDoProduto, (intQuantidade * (-1))
       MsgBox "Operação concluída com sucesso. Novo Estoque de " & modProduto.Nome & ": " & modProduto.Stock & " unidade(s).", vbInformation, vbOKOnly, "Controle de Estoque"
   txtQuantidade = 1
   AtualizaCampos
   Me.ListaProdutos.Requery
   ListaProdutos.SetFocus
   Cliente.Visible = False
   RCliente.Visible = False
   cmdSaída.Visible = False
   Label40.Visible = False
   txtQuantidade.Visible = False
   Produto.Visible = False
   RProduto.Visible = False
   Me.Lista102.Requery
   
   
   
Else
   ListaProdutos.SetFocus
   Cliente.Visible = False
   RCliente.Visible = False
   cmdSaída.Visible = False
   Label40.Visible = False
   txtQuantidade.Visible = False
   Produto.Visible = False
   RProduto.Visible = False

   Exit Sub
End If
Exit Sub

Tratamento:
Const conErrNulo = 94
If err = conErrNulo Then
   MsgBox "É necessário selecionar um Medicamento.", vbExclamation + vbOKOnly, "Controle de Estoque"
   Exit Sub
End If
End Sub


Envio abaixo o aplicativo para quem puder baixar e me ajudar a encontrar o erro.
Um abraço.

Walter

Walter
Faça um teste

Registe uma entrada de um produto de 20000 unidades, Grave.

Feche a BD e volte abrir ..... estão lá as 20000 unidades registadas no produto que escolheu ?
Aguardo

Boa noite, Assis.
Obrigado pela sua atenção à minha dúvida. Fiz o teste e, realmente, ALGUMAS VEZES o estoque fica atualizado ao reabrir o banco, mas não é todas as vezes. Tentei inserir 60.000 no estoque de "Agua Bidestilada" e, ao clicar no botão não acontece nada e ao reabrir o BD o valor também não foi acrescentado ao estoque.

Walter

Este é o comando original da BD para Gravar

Aonde está aprte que está a vermelho ?

'Aumenta a quantidade do produto no Stock
Dim intQuantidade As Integer
Dim lngCódigoDoProduto As Long

On Error GoTo Tratamento
intQuantidade = txtQuantidade
lngCódigoDoProduto = ListaProdutos
If MsgBox("Deseja acrescentar " & intQuantidade & _
" unidade(s) ao Stock de " & modProduto.Nome & "?", _
vbQuestion + vbYesNo, "Gestão de Economato") = vbYes Then
   intQuantidade = txtQuantidade
   modProduto.AcertaStock1 lngCódigoDoProduto, intQuantidade
   MsgBox "Operação concluída com sucesso. Novo Stock de " & _
   modProduto.Nome & ": " & modProduto.Stock & " unidade(s).", _
   vbInformation + vbOKOnly, "Gestão de Economato"
   txtQuantidade = 1
   AtualizaCampos
   ListaProdutos.SetFocus
Else
   Exit Sub
End If

Dim strSQL As String

   strSQL = "SELECT DISTINCTROW qryHistórico.Data, qryHistórico.Entrou, qryHistórico.Saiu, qryHistórico.Utilizador " & vbCrLf & _
   "FROM qryHistórico " & vbCrLf & _
   "WHERE qryHistórico.Data >= Date() AND qryHistórico.Cód_Prod= " & Forms!frmEconomato!ListaProdutos.Column(0) & " " & vbCrLf & _
   "ORDER BY qryHistórico.Data DESC , qryHistórico.Cód_Mov DESC;"
   
   Me.ListaHistórico.RowSource = strSQL
   Me.ListaProdutos.Requery
   Me.ListaHistórico.Requery
Exit Sub

Tratamento:
Const conErrNulo = 94
If err = conErrNulo Then
   MsgBox "É necessário selecionar um produto.", vbExclamation + vbOKOnly, "Gestão de Economato"
   Exit Sub
End If

Assis.
Inseri a parte do código em vermelho, que você sugeriu mas também não obtive sucesso.
Veja que no BD original "Gestão de Economato" também não dá prá inserir valor alto como 60.000. Será alguma limitação do Aplicativo?

Walter

Daqui a pouco tempo envio surpresa

Espere

Seciona o Utilizador

Digita a Password  que é (1 2 3 4 5 6)   e dá Enter

Entre no Menu Registar

Teste e explore...............

Muito bem, Assis.
Achei muito boa a sua adaptação para o Sistema.
Parabéns.
Fico muito agradecido pela sua atenção.
Vou explorar melhor o mesmo.

Um abraço,

Walter

Nos extratos dos produtos tem a opção de anular entradas e saidas, com duplo click sobre a linha que desejar

Explore

Muito bom mesmo, Assis.
Vou aproveitar algumas ideias que você implementou nesse BD, se você permitir, claro.
Quanto ao numero que o Banco não aceita, veja que no seu também da o mesmo problema se o valor for alto.
Achei, no Fórum mesmo, uma postagem do JPaulo que resolveu o problema:

Amigão note que esse exemplo não foi concebido para esse tipo de valores.

No entanto, você se não sabe fica agora a saber, que o formato Integer apenas funfa com o valor de -32,768 a 32,767.

Para resolver para o que pretende, você deve alterar, de Integer para Long nos códigos.

no módulo modProduto;

Private iStock As Long

Public Function AcertaStock(CódigoDoProduto As Long, Quantidade As Long)

Public Function AcertaStock1(CódigoDoProduto As Long, Quantidade As Long)


No form;

Private Sub cmdEntrada_Click()
'Aumenta a quantidade do produto no Stock
Dim intQuantidade As Long

Private Sub cmdSaída_Click()
'Reduz a quantidade do produto no stock
Dim intQuantidade As Long




Problema resolvido.

Um grande abraço.

Walter

Obrigado Walter

Com não estou a usar essas quantidades não tinha detetado o erro

Obrigado e corrigido

Boa noite