Te he preparado este ejemplo, utiliza 2 tablas y 2 formularios, Las consultas están el código.
TABLAS
Diseño de la tabla:
El campo aplica es necesario para ir marcando las facturas que se les ha aplicado la diferencia para no volver a aplicar.
Diseño de la tabla:
Observe el campo id, es necesario para localizar la factura que se va aplicar el ajuste.
FORMULARIO PRINCIPAL
Consta de un cuadro de lista con el siguiente diseño:
Observe que el campo aplicada tiene el criterio Falso, esto para que únicamente muestre las facturas que no se le han aplicado la diferencia.
Cada vez que se aplica se actualiza la información del subformulario, no es necesario aquí se muestra solo con fines didácticos.
CODIGO DEL BOTON APLICAR
En el código está la parte esencial del ejemplo:
Private Sub cmdAplicar_Click()
' Ejemplo preparado por EDUARDO PEREZ FERNANDEZ
' Para TODOEXPERTOS
' Fecha: 25/10/2017
On Error GoTo hay_err
Dim db As Database
Dim rs As Recordset
Dim strSQl As String
Dim dif As Double
Dim lnID As Long
Dim lnFactura As Long
If IsNull(Me.cbo_factura) Then
Me.cbo_factura.SetFocus
Exit Sub
End If
dif = Me.cbo_factura.Column(1)
strSQl = "SELECT tbl_productos.id" & vbCrLf
strSQl = strSQl & " , tbl_productos.nro_factura" & vbCrLf
strSQl = strSQl & " , tbl_productos.valor" & vbCrLf
strSQl = strSQl & " FROM tbl_productos" & vbCrLf
strSQl = strSQl & " WHERE tbl_productos.nro_factura =" & Val(Me.cbo_factura) & vbCrLf
If dif < 0 Then
strSQl = strSQl & " AND [valor]" & dif & ">0" & ";"
Else
strSQl = strSQl & ";"
End If
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQl)
lnID = rs.Fields("id")
lnFactura = rs.Fields("nro_factura")
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
' Actualizo la tabla tbl_productos
DoCmd.SetWarnings (False)
DoCmd.RunSQL "UPDATE tbl_productos SET valor = [valor]+(" & dif & ")" & " WHERE id =" & lnID & ";"
If Err.Number = 0 Then
'Actualizo la tabla de diferencias
DoCmd.RunSQL "UPDATE tbl_diferencias SET aplicada=TRUE WHERE nro_factura=" & lnFactura & ";"
Me.cbo_factura = Null
Me.cbo_factura.Requery
Me.frmSub_productos.Form.Requery
MsgBox "Diferencia registrada OK", vbInformation, "Diferencias"
End If
hay_err_exit:
Exit Sub
hay_err:
MsgBox Err.Number & " " & Err.Description, vbCritical, "Error..."
Resume hay_err_exit
End Sub
Hay otro código para el cuadro de lista para controlar que únicamente se ingrese una factura de la lista:
Private Sub cbo_factura_NotInList(NewData As String, Response As Integer)
MsgBox "Seleccione una factura de la lista", vbInformation, "Diferencias"
Response = acDataErrContinue
End Sub
Espero te sirva y lo puedas adaptar, en caso contrario envíame tu solicitud del ejemplo a [email protected] anotando en asunto lo requerido.