Pessoal, venha aqui pedir ajuda de dos grandes mestres, estou com um aplicativo em anexo que estou tentando adapitar o código para mim, porém estou levando uma grande surra, já estou algumas semanas quebrando a cabeça para colocar em funcionamento mais ainda não conseguir, por este o motivo pesso para algûem que entendir bastante dos códigos para corrigir algumas falhas, quem poder mim ajuda favor peço pois não consigo mais dormir so pensando nisto, para o grande mestre JPaulo, favor manda uma luz, Help.
formulário: frmpedidos.
pessoal, não conseguir anexar o aplicativo por isto postei todo código
Private Sub AtualizaEstoque_Click()
On Error GoTo TrataErroSistema
Const MB_ICONQUESTION = 32
Const YES = 6
Const YES_NO = 4
Dim i As Integer, ItemPedido As Form, Cancelar As Integer, ValTotPed As Single
Dim wsSistema As Workspace, BD As Database, rsProduto As Recordset
Dim rsComissao As Recordset, rsCliente As Recordset, rsPedido As Recordset
Dim Mensagem As String, CTRL As String, DataHoraAtual
Dim CancelarTransacao As Integer
'Variável de controle para o caso de algum critério que não esteja acordo
'se ela ficar true indica que todas as atualizações nas tabelas devem ser canceladas
CancelarTransacao = False
Mensagem = "" 'Mensagem do erro ocorrido
CTRL = Chr(13) & Chr(10)
DataHoraAtual = Now
' Objeto subform frmSubFormItemPedido
Set ItemPedido = Forms!frmPedido!frmSubFormItemPedido.Form
' Pega o workspace padrão
Set wsSistema = DBEngine.Workspaces(0)
' Pega a base de dados corrente
Set BD = wsSistema.Databases(0)
' Abre as tabelas tblProduto, tblComissãoFuncionário,tblCliente e tblPedido
Set rsProduto = BD.OpenRecordset("tblProduto", DB_OPEN_TABLE)
Set rsComissao = BD.OpenRecordset("tblComissãoFuncionário", DB_OPEN_TABLE)
Set rsCliente = BD.OpenRecordset("tblCliente", DB_OPEN_TABLE)
Set rsPedido = BD.OpenRecordset("tblPedido", DB_OPEN_TABLE)
'Verifica se todos os dados necessários para que a emissão do pedido foram fornecidos
'para verificar se existe algum item de pedido é usado o RecordSetClone do frmSubFormItemPedido
If IsNull(Me!IdCliente) Or IsNull(IdFuncionário) Or ItemPedido.RecordsetClone.RecordCount = 0 Then
MsgBox "Falta o Cliente ou Funcionário ou nenhum produto foi escolhido", 16, "Problemas com dados"
Exit Sub
End If
'
'INÍCIO DA TRANSAÇÃO DAS QUATRO TABELAS
'comando usado para iniciar uma transação
On Error GoTo TrataErroRollBack
wsSistema.BeginTrans
'
'tblProduto: Atualização dos estoques
rsProduto.Index = "PrimaryKey" 'Seleciona a chave primária como índice
'Vai para o primeiro item da lista de pedidos
ItemPedido.RecordsetClone.MoveFirst
ValTotPed = 0
'Inicia o "loop" com todos os itens de pedido
For i = 1 To ItemPedido.RecordsetClone.RecordCount
'Encontra o item do pedido na tabela rsProduto
rsProduto.Seek "=", ItemPedido.RecordsetClone.Fields("IdProduto")
'Verifica se há estoque disponível para a operação
obs: apresenta o erro em rsProduto.Estoque
If rsProduto.Estoque >= ItemPedido.RecordsetClone.Fields("Quantidade") Then
'Permite a Edição do produto cujo estoque está sendo atualizado
rsProduto.Edit
'Atualiza o estoque de tblProduto retirando a quantidade solicitada
rsProduto.Estoque = rsProduto.Estoque - ItemPedido.RecordsetClone.Fields("Quantidade")
'Atualiza a data/hora da baixa em tblProduto
rsProduto.DataAtualização = DataHoraAtual
'Atualiza o funcionário que efetuou a operação em tblProduto
rsProduto.IdFuncionário = Me!IdFuncionário
'Salva as atualizações
rsProduto.Update
'Calcula o valor total do pedido para atualizar o crédito do cliente e a comissão do funcionário
ValTotPed = ValTotPed + ItemPedido.RecordsetClone.Fields("Quantidade") * ItemPedido.RecordsetClone.Fields("PreçoProduto")
'Vai par o próximo item do pedido
ItemPedido.RecordsetClone.MoveNext
Else
'Algum produto estava com falta de estoque. Toda a transação será cancelada ao final do procedimento
CancelarTransacao = True
Mensagem = Mensagem & "Não existe uma quantidade suficiente do produto " & rsProduto.Descrição & " para efetuar esta transação" & CTRL
Exit For
End If
Next i
'tblComissãoFuncionário: Inclusão do comissão de 5% do valor do pedido para o funcionário
'abre um novo registro na tabela tblComissãoFuncionário
rsComissao.AddNew
rsComissao.IdFuncionário = Me!IdFuncionário
rsComissao.IdPedido = Me!NumPedido
rsComissao.ValorComissão = ValTotPed * 0.05 'Comissão de 5%
rsComissao.DataPedido = DataHoraAtual
rsComissao.Update
'
'tblCliente: Subtrai o valor total gasto do crédido do Cliente em tblCliente
rsCliente.Index = "PrimaryKey"
rsCliente.Seek "=", Me!IdCliente
If rsCliente.CréditoCliente >= ValTotPed Then
rsCliente.Edit
rsCliente.CréditoCliente = rsCliente.CréditoCliente - ValTotPed
rsCliente.Update
Else
'O cliente não tem o crédito necessário. Toda a transação será cancelada ao final do procedimento
CancelarTransacao = True
Mensagem = Mensagem & "O Cliente não possui o crédito necessário!" & CTRL
End If
'
'tblPedido: dá baixa no pedido ao registra a data e hora da transação
Me.Refresh
rsPedido.Index = "PrimaryKey"
rsPedido.Seek "=", Me!NumPedido, Me!IdCliente, Me!IdFuncionário 'Encontra o pedido em edição para dar a baixa
rsPedido.Edit
rsPedido.DataConfirmaçãoPedido = DataHoraAtual
rsPedido.Update
'
'Cancela ou não a transação mediante ao valor (True/False) da variável CancelarTransacao
If CancelarTransacao Then
'cancelar todas as atualizações feitas no banco de dados
wsSistema.Rollback
MsgBox Mensagem, 16, "Operação Cancelada"
Else
'Possibilita ao usuário confirmar ou não a transação
If MsgBox("Deseja confirmar este pedido e atualizar todas as tabelas?", MB_ICONQUESTION + YES_NO, "Gravando pedido...") = YES Then
'Efetua a transação: atualiza definitivamente todas as quatro tabelas
wsSistema.CommitTrans
'Trava alguns campos que não podem mais ser mudados depois da baixa do pedido
Me!NumPedido.SetFocus
'Muda a cor para mostrar que já foi dada a baixa no pedido corrente
Me!DataConfirmaçãoPedido.BackColor = 255
Me!TextoAtualiza.Visible = False
Me!AtualizaEstoque.Visible = False
Me!IdCliente.Enabled = False
Me!IdFuncionário.Enabled = False
Me!DataPedido.Enabled = False
Me!frmSubFormItemPedido.Locked = True
Else
'Cancela a transação por opção do usuário
wsSistema.Rollback
End If
End If
'Fecha todas as tabelas
rsProduto.Close
rsComissao.Close
rsCliente.Close
rsPedido.Close
SaídaAtualiza:
Exit Sub
'RollBack em caso de erro depois do início da transação
TrataErroRollBack:
wsSistema.Rollback
MsgBox Error$
Resume SaídaAtualiza
TrataErroSistema:
MsgBox Error$
Resume SaídaAtualiza
End Sub
formulário: frmpedidos.
pessoal, não conseguir anexar o aplicativo por isto postei todo código
Private Sub AtualizaEstoque_Click()
On Error GoTo TrataErroSistema
Const MB_ICONQUESTION = 32
Const YES = 6
Const YES_NO = 4
Dim i As Integer, ItemPedido As Form, Cancelar As Integer, ValTotPed As Single
Dim wsSistema As Workspace, BD As Database, rsProduto As Recordset
Dim rsComissao As Recordset, rsCliente As Recordset, rsPedido As Recordset
Dim Mensagem As String, CTRL As String, DataHoraAtual
Dim CancelarTransacao As Integer
'Variável de controle para o caso de algum critério que não esteja acordo
'se ela ficar true indica que todas as atualizações nas tabelas devem ser canceladas
CancelarTransacao = False
Mensagem = "" 'Mensagem do erro ocorrido
CTRL = Chr(13) & Chr(10)
DataHoraAtual = Now
' Objeto subform frmSubFormItemPedido
Set ItemPedido = Forms!frmPedido!frmSubFormItemPedido.Form
' Pega o workspace padrão
Set wsSistema = DBEngine.Workspaces(0)
' Pega a base de dados corrente
Set BD = wsSistema.Databases(0)
' Abre as tabelas tblProduto, tblComissãoFuncionário,tblCliente e tblPedido
Set rsProduto = BD.OpenRecordset("tblProduto", DB_OPEN_TABLE)
Set rsComissao = BD.OpenRecordset("tblComissãoFuncionário", DB_OPEN_TABLE)
Set rsCliente = BD.OpenRecordset("tblCliente", DB_OPEN_TABLE)
Set rsPedido = BD.OpenRecordset("tblPedido", DB_OPEN_TABLE)
'Verifica se todos os dados necessários para que a emissão do pedido foram fornecidos
'para verificar se existe algum item de pedido é usado o RecordSetClone do frmSubFormItemPedido
If IsNull(Me!IdCliente) Or IsNull(IdFuncionário) Or ItemPedido.RecordsetClone.RecordCount = 0 Then
MsgBox "Falta o Cliente ou Funcionário ou nenhum produto foi escolhido", 16, "Problemas com dados"
Exit Sub
End If
'
'INÍCIO DA TRANSAÇÃO DAS QUATRO TABELAS
'comando usado para iniciar uma transação
On Error GoTo TrataErroRollBack
wsSistema.BeginTrans
'
'tblProduto: Atualização dos estoques
rsProduto.Index = "PrimaryKey" 'Seleciona a chave primária como índice
'Vai para o primeiro item da lista de pedidos
ItemPedido.RecordsetClone.MoveFirst
ValTotPed = 0
'Inicia o "loop" com todos os itens de pedido
For i = 1 To ItemPedido.RecordsetClone.RecordCount
'Encontra o item do pedido na tabela rsProduto
rsProduto.Seek "=", ItemPedido.RecordsetClone.Fields("IdProduto")
'Verifica se há estoque disponível para a operação
obs: apresenta o erro em rsProduto.Estoque
If rsProduto.Estoque >= ItemPedido.RecordsetClone.Fields("Quantidade") Then
'Permite a Edição do produto cujo estoque está sendo atualizado
rsProduto.Edit
'Atualiza o estoque de tblProduto retirando a quantidade solicitada
rsProduto.Estoque = rsProduto.Estoque - ItemPedido.RecordsetClone.Fields("Quantidade")
'Atualiza a data/hora da baixa em tblProduto
rsProduto.DataAtualização = DataHoraAtual
'Atualiza o funcionário que efetuou a operação em tblProduto
rsProduto.IdFuncionário = Me!IdFuncionário
'Salva as atualizações
rsProduto.Update
'Calcula o valor total do pedido para atualizar o crédito do cliente e a comissão do funcionário
ValTotPed = ValTotPed + ItemPedido.RecordsetClone.Fields("Quantidade") * ItemPedido.RecordsetClone.Fields("PreçoProduto")
'Vai par o próximo item do pedido
ItemPedido.RecordsetClone.MoveNext
Else
'Algum produto estava com falta de estoque. Toda a transação será cancelada ao final do procedimento
CancelarTransacao = True
Mensagem = Mensagem & "Não existe uma quantidade suficiente do produto " & rsProduto.Descrição & " para efetuar esta transação" & CTRL
Exit For
End If
Next i
'tblComissãoFuncionário: Inclusão do comissão de 5% do valor do pedido para o funcionário
'abre um novo registro na tabela tblComissãoFuncionário
rsComissao.AddNew
rsComissao.IdFuncionário = Me!IdFuncionário
rsComissao.IdPedido = Me!NumPedido
rsComissao.ValorComissão = ValTotPed * 0.05 'Comissão de 5%
rsComissao.DataPedido = DataHoraAtual
rsComissao.Update
'
'tblCliente: Subtrai o valor total gasto do crédido do Cliente em tblCliente
rsCliente.Index = "PrimaryKey"
rsCliente.Seek "=", Me!IdCliente
If rsCliente.CréditoCliente >= ValTotPed Then
rsCliente.Edit
rsCliente.CréditoCliente = rsCliente.CréditoCliente - ValTotPed
rsCliente.Update
Else
'O cliente não tem o crédito necessário. Toda a transação será cancelada ao final do procedimento
CancelarTransacao = True
Mensagem = Mensagem & "O Cliente não possui o crédito necessário!" & CTRL
End If
'
'tblPedido: dá baixa no pedido ao registra a data e hora da transação
Me.Refresh
rsPedido.Index = "PrimaryKey"
rsPedido.Seek "=", Me!NumPedido, Me!IdCliente, Me!IdFuncionário 'Encontra o pedido em edição para dar a baixa
rsPedido.Edit
rsPedido.DataConfirmaçãoPedido = DataHoraAtual
rsPedido.Update
'
'Cancela ou não a transação mediante ao valor (True/False) da variável CancelarTransacao
If CancelarTransacao Then
'cancelar todas as atualizações feitas no banco de dados
wsSistema.Rollback
MsgBox Mensagem, 16, "Operação Cancelada"
Else
'Possibilita ao usuário confirmar ou não a transação
If MsgBox("Deseja confirmar este pedido e atualizar todas as tabelas?", MB_ICONQUESTION + YES_NO, "Gravando pedido...") = YES Then
'Efetua a transação: atualiza definitivamente todas as quatro tabelas
wsSistema.CommitTrans
'Trava alguns campos que não podem mais ser mudados depois da baixa do pedido
Me!NumPedido.SetFocus
'Muda a cor para mostrar que já foi dada a baixa no pedido corrente
Me!DataConfirmaçãoPedido.BackColor = 255
Me!TextoAtualiza.Visible = False
Me!AtualizaEstoque.Visible = False
Me!IdCliente.Enabled = False
Me!IdFuncionário.Enabled = False
Me!DataPedido.Enabled = False
Me!frmSubFormItemPedido.Locked = True
Else
'Cancela a transação por opção do usuário
wsSistema.Rollback
End If
End If
'Fecha todas as tabelas
rsProduto.Close
rsComissao.Close
rsCliente.Close
rsPedido.Close
SaídaAtualiza:
Exit Sub
'RollBack em caso de erro depois do início da transação
TrataErroRollBack:
wsSistema.Rollback
MsgBox Error$
Resume SaídaAtualiza
TrataErroSistema:
MsgBox Error$
Resume SaídaAtualiza
End Sub