Juliocsar 29/6/2021, 23:02
A diferença do desconto eu joguei no item com maior valor total, existe um erro também nos tipos de campos If xTotal <> txtDescProd, mesmo que os valores pareçam o mesmo eles não são pois, numerico é diferente de texto, então por isso converti o campo do tipo texto para numerico para ser possivel fazer a comparação, ficando assim:
Private Sub RateiaDesconto()
Dim xDescontoRateio, xItem, xTotal, xDescontoResiduo
Dim xPercentual
Dim ValorMaiorPedido As Double
Set dbs = CurrentDb
strSQL = "SELECT * FROM zzz_tbl_VendasItens WHERE NUMEROPEDIDO = " & "'" & txtNUMEROPEDIDO & "'"
Set rst = dbs.OpenRecordset(strSQL)
xTotal = 0
Do While Not rst.EOF
xItem = rst("ITEM")
xPercentual = txtDescProd / txtMERCADORIAS * 100
xDescontoRateio = Format(rst("TOTAL") * (xPercentual) / 100, "##,##0.00")
strSQL = "UPDATE zzz_tbl_VendasItens set DESCONTO = '" & xDescontoRateio & "'"
strSQL = strSQL & " WHERE NUMEROPEDIDO = " & "'" & txtNUMEROPEDIDO & "'"
strSQL = strSQL & " AND ITEM = " & "'" & xItem & "'"
Workspaces(0).Databases(0).Execute strSQL
rst.MoveNext
xTotal = xTotal + xDescontoRateio
Loop
'Jogar a Diferença no Item com Maior Valor
If xTotal <> CDbl(txtDescProd) Then
ValorMaiorPedido = DMax("Total", "zzz_tbl_VendasItens") * 100
ID_Registro = DLookup("ID_Pedido", "zzz_tbl_VendasItens", "Total*100 = " & ValorMaiorPedido)
xDescontoResiduo = Format((txtDescProd - xTotal), "##,##0.00")
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE zzz_tbl_VendasItens SET DESCONTO = [Desconto]+ '" & xDescontoResiduo & "' WHERE ID_PEDIDO=" & ID_Registro, -1
DoCmd.SetWarnings True
xTotal = xTotal + xDescontoResiduo
End If
If xTotal <> CDbl(txtDescProd) Then
MsgBox "Há diferença no valor do desconto", vbCritical, "Desconto"
End If
txtDescSistema = xTotal
txtDifValor = txtDescProd - txtDescSistema
txtValorTotal2 = txtMERCADORIAS - txtDescSistema
rst.Close
Me.Requery
End Sub