Convidado 4/7/2011, 02:41
Sua Solução
Realmente a instrução UPDATE neste caso estava a não aceitar numeros decimais...
Então utilizei um recordset para fazer o update na tabela..
Testei e funcionou.
Private Sub Quant_AfterUpdate()
'=====================================================
'FAVOR NÃO RETIRE OS CRÉDITOS
'por Glicério Júnior (Jungli) ... jungli@ibest.com.br em 8.6.2011
'Modificado por: Harysohn Pina em 03/07/2011
'=====================================================
On Error GoTo Err_Quant_AfterUpdate
Dim db As DAO.Database 'Variavel para o BD
Dim ws As DAO.Workspace 'Variável para o Workspace
Dim rs As DAO.Recordset 'Variável para o recordSet
Dim StrSQLEstoque 'Variável para receber os dados da tabela
Dim qtd, qtd2 As Double
Dim sql1 As String
qtd = DLookup("[Estoque]", "[produtos]", "[ID] = " & Me.CodProduto.Column(0))
If qtd <= 0 Or qtd <= Me.Quant Then
MsgBox "O estoque está zerado" & vbCrLf & _
"ou número em estoque menor do" & vbCrLf & _
"que a quantidade informada.", _
vbCritical, "ESTOQUE INSUFICIENTE"
Me.Undo
Me.CodProduto.SetFocus
Me.CodProduto.Dropdown
ElseIf qtd > 0 And qtd > Me.Quant Then
If MsgBox("Você tem certeza que deseja atualizar o estoque??", vbQuestion + vbYesNo, "Pergunta") = vbYes Then
qtd2 = (qtd - Quant)
'Seta o WorksPace e o BD para fazer a atualização da tabela, obseve que tem que modifica o nome do BD conforme o nome que vais usar, no caso está como Diego.mdb
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(CurrentProject.Path & "\Diego.mdb", False, False, "MS Access;PWD=senha")
'Aqui a variável faz a seleção de todos os campos da tabela selecionando o registro que coincide com a CixaTexto COdProduto
StrSQLEstoque = "SELECT * FROM Produtos WHERE (((produtos.ID)=" & Me.CodProduto.Column(0) & "));"
Set rs = db.OpenRecordset(StrSQLEstoque)
rs.Edit ' Abre a edição do registro para tabela Produtos
rs![Estoque] = qtd2
rs.Update ' Atualiza o registro para tabela Produtos
'Encerra o Banco db e o recordSet
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
Else
Me.Undo
Me.CodProduto.SetFocus
Me.CodProduto.Dropdown
End If
End If
Exit_Quant_AfterUpdate:
Exit Sub
Err_Quant_AfterUpdate:
MsgBox err.Description, vbCritical, "Erro Indeterminado"
Resume Exit_Quant_AfterUpdate
End Sub
Saudações