Inserir Inputbox

Bom Dia Aguem poderia me ajudar como faço pra por um Inputbox que o usuário insira um valor que faz a multiplicação com o produto


Codigo da Pagina de Vendas


Option Compare Database
Option Explicit

Private Sub btnCancelar_Click()

Dim objVenda As New clsVenda
Dim objDetalheVenda As New clsDetalheVenda
Dim objProduto As New clsProduto
Dim rstLista As Recordset

If objVenda.obter(Nz(txtCodigoVenda, -1)) Then

If MsgBox("Confirma o cancelamento da venda?", _
vbQuestion + vbYesNo, "Cancelar Venda") = vbYes Then

Set rstLista = objDetalheVenda.getListaProduto(txtCodigoVenda)

While Not rstLista.EOF
Call objProduto.obter(rstLista("codProduto"))
Call objProduto.subirEstoque(rstLista("qtdProduto"))
rstLista.MoveNext
Wend

If objVenda.Excluir Then
MsgBox "A venda foi cancelada com sucesso.", _
vbInformation, "Cancelar Venda"
Call limpaCampos
Else
MsgBox "Ocorreu um erro durante o cancelamento.", _
vbExclamation, "Cancelar Venda"
End If

End If

End If

End Sub

Private Sub btnExcluirProduto_Click()

Dim objDetalheVenda As New clsDetalheVenda
Dim objProduto As New clsProduto
Dim codigoProduto As String

If Not IsNull(txtCodigoVenda) Then
codigoProduto = Inputbox("Informe o código do produto a ser excluído:", _
"Exclusão de Produto")
Else
Exit Sub
End If

If codigoProduto <> "" Then
If IsNumeric(codigoProduto) Then
If objDetalheVenda.obter(CStr(codigoProduto), CLng(txtCodigoVenda)) Then
If objProduto.obter(CStr(codigoProduto)) Then
If objProduto.subirEstoque(objDetalheVenda.qtdProduto) Then
If objDetalheVenda.Excluir Then
MsgBox "O produto foi excluído com sucesso!", _
vbInformation, "Exclusão de Produto"
Call atualizaLista
Else
MsgBox "Ocorreu um erro durante a exclusão do produto!", _
vbExclamation, "Exclusão de Produto"
End If
End If
End If
End If
Else
MsgBox "Código de produto inválido!", _
vbExclamation, "Exclusão de Produto"
End If
End If

End Sub

Private Sub btnFechar_Click()
If MsgBox(" Deseja fechar vendas?", vbYesNo + vbDefaultButton1 + vbInformation, "Aviso!") = vbYes Then
DoCmd.Close
End If
End Sub



Private Sub limpaCampos()
txtCodigoVenda = Null
txtData = Null
txtCodCliente = Null
txtNomeCliente = Null
txtProdutoQtd = Null
txtTotal = Null
txtPago = Null
txtTroco = Null
txtNomePro = Null
txtEstoqueAtual = Null
Call limpaExibicaoProduto
lblProdutos.Caption = ""
txtNomePro.SetFocus
End Sub

Private Sub limpaExibicaoProduto()
txtDescricao = Null
txtUnidade = Null
txtQtd = Null
txtValorUnt = Null
txtSubtotal = Null
End Sub


Private Sub btnNovo_Click()
'Botao definido para pagamento em dinheiro
Dim rs As Recordset
Dim varTotDivida As Variant
Dim vartotpago As Variant

'Grava a forma de pagamento em dinheiro no banco de dados
DoCmd.SetWarnings False
If (0 + (txtTotal) <> 0) And (txtCodigoVenda <> "") Then


DoCmd.RunSQL ("UPDATE Venda SET PAGO = 'Dinheiro', valorpago='" & Me.txtTotal & "', " & _
"Dinheiro='" & Me.txtTotal & "' " & _
"WHERE codvenda=" & txtCodigoVenda & ";")

DoCmd.RunSQL ("UPDATE DetalheVenda SET valorpago='" & Me.txtTotal & "', " & _
"Dinheiro='" & Me.txtTotal & "' " & _
"WHERE codvenda=" & txtCodigoVenda & ";")



If MsgBox(" Deseja imprimir a venda?", vbYesNo + vbDefaultButton1 + vbInformation, "Aviso!") = vbYes Then
DoCmd.OpenReport "RCupom", acViewPreview, , , , txtCodigoVenda
'DoCmd.PrintOut

Call limpaCampos
txtNomePro.SetFocus
Else
MsgBox " Venda efetuada com sucesso!"
Call limpaCampos
DoCmd.GoToRecord , , acNewRec
Me.Requery
txtNomePro.SetFocus
End If
Else
MsgBox "Sem dados para gravar no banco de dados, ou total = 0,00.", vbCritical + vbOKOnly, "Sem dados!"

End If

End Sub

Private Sub btComprasCli_Click()
DoCmd.OpenForm "frmcomprascliente"
End Sub

Private Sub cmdFiado_Click()
Dim rs As Recordset
Dim varTotDivida As Variant
Dim vartotpago As Variant

If IsNull(Me.txtCodCliente) Or Me.txtCodCliente = "" Then
MsgBox "Para vender fiado, deve identificar o cliente!", vbCritical + vbOKOnly, "Atenção!"
Exit Sub
Else

DoCmd.SetWarnings False
DoCmd.RunSQL ("UPDATE Venda SET Venda.PAGO = 'não' " _
& "WHERE Venda.codvenda=" & Me.txtCodigoVenda & ";")

varTotDivida = DLookup("[valordivida]", "Receber", "[codigo]=2")


DoCmd.RunSQL ("UPDATE Receber SET valordivida ='" & varTotDivida + Me.txtTotal & "' Where codigo= 2;")

'vartotpago = DLookup("[valorpago]", "Receber", "[codigo]=2")

'DoCmd.RunSQL ("UPDATE Receber SET valorpago ='" & vartotpago - Me.txtTotal & "' Where codigo= 2;")

If MsgBox(" Deseja imprimir a venda?", vbYesNo + vbDefaultButton1 + vbInformation, "Aviso!") = vbYes Then
DoCmd.OpenReport "RCupom divida", acViewPreview, , , , txtCodigoVenda
'DoCmd.PrintOut

Call limpaCampos
txtNomePro.SetFocus
Else
MsgBox " Venda efetuada com sucesso!"
Call limpaCampos
DoCmd.GoToRecord , , acNewRec
Me.Requery
txtNomePro.SetFocus
End If
End If

End Sub

Private Sub Form_Activate()
DoCmd.Maximize
End Sub


Private Sub Form_Load()
Me.[txtProdutoQtd].SetFocus
Me.[txtCodCliente].SetFocus
End Sub




Private Sub lblProdutos_DblClick(Cancel As Integer)
If Not IsNull(txtCodigoVenda) Then
DoCmd.OpenReport "RCupom", acViewPreview, , , , txtCodigoVenda
End If
End Sub

Private Sub txtBusca_AfterUpdate()
Me.Listacliente.Requery
End Sub

Private Sub txtBusca_Change()
Me.Recalc
SendKeys "{F2}"
End Sub

Private Sub txtCodCliente_AfterUpdate()

Dim objCliente As New clsCliente

If Not IsNull(txtCodCliente) Then
If objCliente.obter(CLng(txtCodCliente)) Then
Call preencheVenda

txtNomeCliente = objCliente.nomeCliente
Else
txtNomeCliente = Null
txtCodCliente = Null
MsgBox "Código do cliente inválido!", _
vbExclamation, "Erro!"

End If
End If


End Sub

Private Sub txtNomePro_AfterUpdate()
On Error Resume Next
Me.txtNomePro.Requery
Me.txtProdutoQtd.Enabled = True
Me.txtProdutoQtd.SetFocus
Me.txtProdutoQtd.SelText = Me.txtNomePro.Column(0)
Me.txtDescricao = Me.txtNomePro.Column(1)
Me.txtEstoqueAtual = Me.txtNomePro.Column(3)
txtNomePro = Null
txtUnidade = Null
txtQtd = Null
txtValorUnt = Null
txtSubtotal = Null

Me.Refresh

End Sub

Private Sub txtPago_AfterUpdate()
If Not IsNull(txtPago) Then
txtTroco = CDbl(txtPago) - CDbl(Nz(txtTotal))
Else
txtTroco = Null
End If
End Sub

Private Sub txtProdutoQtd_AfterUpdate()
btnNovo.SetFocus
txtProdutoQtd.SetFocus

txtProdutoQtd = Null
txtEstoqueAtual = Null
Call preencheVenda
'Call atualizaLista
End Sub

Sub atualizaLista()

Dim objVenda As New clsVenda

If Not IsNull(txtCodigoVenda) Then
If objVenda.obter(txtCodigoVenda) Then
lblProdutos.Caption = listaProdutos(Nz(txtCodigoVenda, -1), 10)
txtTotal = objVenda.getValorTotal
Call txtPago_AfterUpdate
End If
End If

End Sub

Sub preencheVenda()

If IsNull(txtCodigoVenda) Then
txtCodigoVenda = proximoCodigo("codVenda", "Venda")
End If

If IsNull(txtData) Then
txtData = Date
End If

End Sub

Sub exibeProduto(argDetalhe As clsDetalheVenda)

Dim objProduto As New clsProduto

If objProduto.obter(argDetalhe.codProduto) Then
txtDescricao = objProduto.descricao
txtEstoqueAtual = objProduto.qtdEstoque

txtUnidade = objProduto.unidade
txtQtd = argDetalhe.qtdProduto
txtValorUnt = objProduto.valorUnitario
txtSubtotal = argDetalhe.getSubTotal
End If

End Sub

Private Sub txtProdutoQtd_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_txtProdutoQtd_AfterUpdate

Dim codigoProduto As String
Dim qtdProduto As Double
Dim posicao As Integer
Dim Status As Integer
Dim objVenda As New clsVenda
Dim objDetalhe As New clsDetalheVenda
Dim objProduto As New clsProduto

Status = 0
If Not IsNull(txtProdutoQtd) Then

Call preencheVenda

posicao = InStr(txtProdutoQtd, "*")

If posicao > 0 Then
Status = 1
codigoProduto = CStr(Left(txtProdutoQtd, posicao - 1))
Status = 2
qtdProduto = CDbl(Right(txtProdutoQtd, Len(txtProdutoQtd) - posicao))
Else
Status = 3
codigoProduto = CStr(txtProdutoQtd)
qtdProduto = 1
End If

Status = 4
objVenda.codVenda = CLng(txtCodigoVenda)

Status = 5
objVenda.dataVenda = CDate(txtData)

Status = 6
If Not IsNull(txtCodCliente) Then
objVenda.codCliente = CLng(txtCodCliente)
End If

If objProduto.obter(codigoProduto) Then
If objProduto.qtdEstoque < qtdProduto Then
MsgBox "O estoque existente não é suficiente!" & vbCrLf & vbLf & _
"Estoque atual: " & FormatNumber(objProduto.qtdEstoque, 3) & _
" " & objProduto.unidade, _
vbExclamation, "Estoque Baixo"
Cancel = True
Exit Sub
End If
End If

Status = 7
If objVenda.salvar Then
objDetalhe.codVenda = objVenda.codVenda
objDetalhe.codProduto = codigoProduto
objDetalhe.qtdProduto = qtdProduto
Status = 8
If objDetalhe.salvar Then
Call exibeProduto(objDetalhe)
Call atualizaLista
If objProduto.obter(codigoProduto) Then
Status = 9
If objProduto.baixarEstoque(qtdProduto) Then
If objProduto.estoqueBaixo Then
MsgBox "O estoque ficou abaixo da quantidade mínima!" & _
vbCrLf & vbLf & _
"Estoque atual: " & FormatNumber(objProduto.qtdEstoque, 3) & _
" " & objProduto.unidade, vbExclamation, "Estoque Baixo"
End If
Else
MsgBox "Ocorreu um erro na atualização do estoque.", _
vbExclamation, "Erro!"
End If
End If
Else
MsgBox "Ocorreu um erro ao incluir o produto.", _
vbExclamation, "Erro!"
Cancel = True
End If
Else
MsgBox "Ocorreu um erro ao incluir a venda.", _
vbExclamation, "Erro!"
Cancel = True
End If

End If

Exit_txtProdutoQtd_AfterUpdate:
Exit Sub

Err_txtProdutoQtd_AfterUpdate:
Select Case Status
Case 1, 3
MsgBox "Código do produto inválido!", vbExclamation, "Erro!"
Case 2
MsgBox "Quantidade do produto inválida!", vbExclamation, "Erro!"
Case 5
MsgBox "Data inválida!", vbExclamation, "Erro!"
Case 6
MsgBox "Código do cliente inválido!", vbExclamation, "Erro!"
Case 7
MsgBox "Ocorreu um erro ao incluir a venda!", vbExclamation, "Erro!"
Case 8
MsgBox "Ocorreu um erro ao incluir o produto!", vbExclamation, "Erro!"
Case 9
MsgBox "Ocorreu um erro ao atualizar o estoque!", vbExclamation, "Erro!"
Case Else
MsgBox "Ocorreu um erro. O sistema informou a seguinte mensagem:" & _
vbCrLf & vbLf & Err.Description, vbExclamation, "Erro!"
End Select
Cancel = True
Resume Exit_txtProdutoQtd_AfterUpdate

End Sub

Private Sub txtProdutoQtd_Change()

Dim objProduto As New clsProduto
Dim dblQtdProduto As New clsDetalheVenda



dblQtdProduto = Inputbox("Digita")
If txtProdutoQtd.Text <> "" Then
If InStr(txtProdutoQtd.Text, "") = 0 Then
If IsNumeric(txtProdutoQtd.Text) Then
If objProduto.obter(CStr(txtProdutoQtd.Text)) Then
txtDescricao = objProduto.descricao
txtUnidade = objProduto.unidade
txtEstoqueAtual = objProduto.qtdEstoque
Else
txtDescricao = "Código não cadastrado..."
txtUnidade = Null
txtEstoqueAtual = Null

End If
txtQtd = Null
txtValorUnt = Null
txtSubtotal = Null
End If
End If
Else
txtDescricao = Null
txtUnidade = Null
txtEstoqueAtual = Null

End If

End Sub

Private Sub btnCredito_Click()
'Botao definido para pagamento em Credito
Dim rs As Recordset
Dim varTotDivida As Variant
Dim vartotpago As Variant

'Grava a forma de pagamento em dinheiro no banco de dados
DoCmd.SetWarnings False
If (0 + (txtTotal) <> 0) And (txtCodigoVenda <> "") Then


DoCmd.RunSQL ("UPDATE Venda SET PAGO = 'Credito', valorpago='" & Me.txtTotal & "', " & _
"Credito='" & Me.txtTotal & "' " & _
"WHERE codvenda=" & txtCodigoVenda & ";")

DoCmd.RunSQL ("UPDATE DetalheVenda SET valorpago='" & Me.txtTotal & "', " & _
"Credito='" & Me.txtTotal & "' " & _
"WHERE codvenda=" & txtCodigoVenda & ";")




If MsgBox(" Deseja imprimir a venda?", vbYesNo + vbDefaultButton1 + vbInformation, "Aviso!") = vbYes Then
DoCmd.OpenReport "RCupom", acViewPreview, , , , txtCodigoVenda
'DoCmd.PrintOut

Call limpaCampos
txtNomePro.SetFocus
Else
MsgBox " Venda efetuada com sucesso!"
Call limpaCampos
DoCmd.GoToRecord , , acNewRec
Me.Requery
txtNomePro.SetFocus
End If

Else
MsgBox "Sem dados para gravar no banco de dados, ou total = 0,00.", vbCritical + vbOKOnly, "Sem dados!"

End If

End Sub

Private Sub btnDebito_Click()
'Botao definido para pagamento em Debito
Dim rs As Recordset
Dim varTotDivida As Variant
Dim vartotpago As Variant

'Grava a forma de pagamento em dinheiro no banco de dados
DoCmd.SetWarnings False
DoCmd.SetWarnings False
If (0 + (txtTotal) <> 0) And (txtCodigoVenda <> "") Then


DoCmd.RunSQL ("UPDATE Venda SET PAGO = 'Debito', valorpago='" & Me.txtTotal & "', " & _
"Debito='" & Me.txtTotal & "' " & _
"WHERE codvenda=" & txtCodigoVenda & ";")

DoCmd.RunSQL ("UPDATE DetalheVenda SET valorpago='" & Me.txtTotal & "', " & _
"Debito='" & Me.txtTotal & "' " & _
"WHERE codvenda=" & txtCodigoVenda & ";")



If MsgBox(" Deseja imprimir a venda?", vbYesNo + vbDefaultButton1 + vbInformation, "Aviso!") = vbYes Then
DoCmd.OpenReport "RCupom", acViewPreview, , , , txtCodigoVenda
'DoCmd.PrintOut

Call limpaCampos
txtNomePro.SetFocus
Else
MsgBox " Venda efetuada com sucesso!"
Call limpaCampos
DoCmd.GoToRecord , , acNewRec
Me.Requery
txtNomePro.SetFocus
End If


'If MsgBox(" Deseja imprimir a venda?", vbYesNo + vbDefaultButton1 + vbInformation, "Aviso!") = vbYes Then
'DoCmd.OpenReport "RCupom", acViewPreview, , , , txtCodigoVenda
''DoCmd.PrintOut
'
' Call limpaCampos
' txtNomePro.SetFocus
' Else
' MsgBox " Venda efetuada com sucesso!"
' Call limpaCampos
' DoCmd.GoToRecord , , acNewRec
' Me.Requery
' txtNomePro.SetFocus
Else
MsgBox "Sem dados para gravar no banco de dados, ou total = 0,00.", vbCritical + vbOKOnly, "Sem dados!"

End If

End Sub


Private Sub txtQtd_BeforeUpdate(Cancel As Integer)

End Sub

Private Sub txtQtd_Change()

End Sub

Private Sub txtQtd_Enter()

End Sub

Aonde você quer por?
Bem o pra multiplicar você pode fazer isso:

Código:

Dim i as Integer
i = CInt(inputbox("Digite um número")) * <produto>

Queria por aqui mais ai quando o usuario por o valor ai faz a multiplicação ai vai pro resumo


Private Sub txtProdutoQtd_Change()

Dim objProduto As New clsProduto
Dim dblQtdProduto As New clsDetalheVenda



dblQtdProduto = Inputbox("Digita")
If txtProdutoQtd.Text <> "" Then
If InStr(txtProdutoQtd.Text, "") = 0 Then
If IsNumeric(txtProdutoQtd.Text) Then
If objProduto.obter(CStr(txtProdutoQtd.Text)) Then
txtDescricao = objProduto.descricao
txtUnidade = objProduto.unidade
txtEstoqueAtual = objProduto.qtdEstoque
Else
txtDescricao = "Código não cadastrado..."
txtUnidade = Null
txtEstoqueAtual = Null

End If
txtQtd = Null
txtValorUnt = Null
txtSubtotal = Null
End If
End If
Else
txtDescricao = Null
txtUnidade = Null
txtEstoqueAtual = Null

End If

End Sub