EL formulario de compras se utiliza para Ingresar Productos al Inventario y para llevar un registro de las compras Ingresada.
Colabora y Suscribete a mi canal de 
El código del formulario de Compras es muy parecido al de Ventas por lo cual se va a utilizar mucho código que ya tenemos en Ventas.
Ya entrando el el modulo de compras lo primero es hacer la parte del ingreso de productos a la factura de Compra.
Lo primero sera ingresar el código en el evento Load del formulario que se encarga de Inicializar y verificar que los datos iniciales estén.
lstListaRapida.Top = 2520
lstListaRapida.Left = 1920
cmdTipoFact.ListIndex = 0
txtFecha.Text = Format(Date, "dd/mm/yyyy")
cmdTipoPago.ListIndex = 0
Private Sub Form_Load()
lstListaRapida.Top = 2520
lstListaRapida.Left = 1920
Call LimpiarCompra
cmdTipoFact.ListIndex = 0
txtFecha.Text = Format(Date, "dd/mm/yyyy")
cmdTipoPago.ListIndex = 0
Call UltimoIDFactura
Call InicializarGrip
Call LlenarGridProductos
End Sub
Private Sub Form_Load()
lstListaRapida.Top = 2520
lstListaRapida.Left = 1920
Call LimpiarCompra
cmdTipoFact.ListIndex = 0
txtFecha.Text = Format(Date, "dd/mm/yyyy")
cmdTipoPago.ListIndex = 0
Call UltimoIDFactura
Call InicializarGrip
Call LlenarGridProductos
End Sub
Si notamos en el código anterior estamos llamando a 3 procedimientos que vamos a ver uno a uno el primero es UltimoIDFactura que se encarga de traer el Ultimo IdCompra mas 1.
Antes de Continuar en las siguientes imagenes puede observar como deben quedar las 2 tablas que se necesitan para poder guardar las compras que son: tblCompras y tblDetalle_Compra:


NumeroFactCompra = UltimoIdTabla("tblCompras", "Id_Compra")
Sub UltimoIDFactura()
NumeroFactCompra = UltimoIdTabla("tblCompras", "Id_Compra")
End Sub
Sub UltimoIDFactura()
NumeroFactCompra = UltimoIdTabla("tblCompras", "Id_Compra")
End Sub
Lo anterior lo único que hace es llamar a una función que ya habíamos programado que se encarga de traernos el Ultimo ID de una tabla determinada.
Continuamos con la InicializacionGrip que le da formato a nuestro Grid, como son el numero de columnas, los títulos y colores.
msGrid.ColWidth(2) = 900 'codigo
msGrid.ColWidth(3) = 4300 'nombre
msGrid.ColWidth(4) = 800 'cantidad
msGrid.ColWidth(5) = 1300 'preciov
msGrid.ColWidth(6) = 1300 'imp
msGrid.ColWidth(7) = 1300 'subtotal
msGrid.ColWidth(8) = 1300 'Desc
msGrid.ColWidth(9) = 1300 'Desc
msGrid.TextMatrix(0, 0) = "ID"
msGrid.TextMatrix(0, 1) = "IdPro"
msGrid.TextMatrix(0, 2) = "Código"
msGrid.TextMatrix(0, 3) = "Nombre Producto"
msGrid.TextMatrix(0, 4) = "Cant"
msGrid.TextMatrix(0, 5) = "Precio C"
msGrid.TextMatrix(0, 6) = "Precio V"
msGrid.TextMatrix(0, 7) = "Impuesto"
msGrid.TextMatrix(0, 8) = "Subtotal"
msGrid.TextMatrix(0, 9) = "Descuento"
'recorre las celdas del titulo del grid y le da color
For I = 1 To msGrid.Cols - 1
msGrid.Col = I 'va recorriendo las celdas de la primera fila
msGrid.CellBackColor = &H8C5828 'color azul para el fondo
msGrid.CellAlignment = flexAlignCenterCenter 'texto centrado
msGrid.CellForeColor = vbWhite 'color blanco para el texto
msGrid.CellFontBold = True 'Negrita
Sub InicializarGrip()
msGrid.Cols = 10
msGrid.Rows = 1
msGrid.ColWidth(0) = 0
msGrid.ColWidth(1) = 0
msGrid.ColWidth(2) = 900 'codigo
msGrid.ColWidth(3) = 4300 'nombre
msGrid.ColWidth(4) = 800 'cantidad
msGrid.ColWidth(5) = 1300 'preciov
msGrid.ColWidth(6) = 1300 'imp
msGrid.ColWidth(7) = 1300 'subtotal
msGrid.ColWidth(8) = 1300 'Desc
msGrid.ColWidth(9) = 1300 'Desc
msGrid.TextMatrix(0, 0) = "ID"
msGrid.TextMatrix(0, 1) = "IdPro"
msGrid.TextMatrix(0, 2) = "Código"
msGrid.TextMatrix(0, 3) = "Nombre Producto"
msGrid.TextMatrix(0, 4) = "Cant"
msGrid.TextMatrix(0, 5) = "Precio C"
msGrid.TextMatrix(0, 6) = "Precio V"
msGrid.TextMatrix(0, 7) = "Impuesto"
msGrid.TextMatrix(0, 8) = "Subtotal"
msGrid.TextMatrix(0, 9) = "Descuento"
'recorre las celdas del titulo del grid y le da color
For I = 1 To msGrid.Cols - 1
msGrid.Row = 0
msGrid.Col = I 'va recorriendo las celdas de la primera fila
msGrid.CellBackColor = &H8C5828 'color azul para el fondo
msGrid.CellAlignment = flexAlignCenterCenter 'texto centrado
msGrid.CellForeColor = vbWhite 'color blanco para el texto
msGrid.CellFontBold = True 'Negrita
Next I
End Sub
Sub InicializarGrip()
msGrid.Cols = 10
msGrid.Rows = 1
msGrid.ColWidth(0) = 0
msGrid.ColWidth(1) = 0
msGrid.ColWidth(2) = 900 'codigo
msGrid.ColWidth(3) = 4300 'nombre
msGrid.ColWidth(4) = 800 'cantidad
msGrid.ColWidth(5) = 1300 'preciov
msGrid.ColWidth(6) = 1300 'imp
msGrid.ColWidth(7) = 1300 'subtotal
msGrid.ColWidth(8) = 1300 'Desc
msGrid.ColWidth(9) = 1300 'Desc
msGrid.TextMatrix(0, 0) = "ID"
msGrid.TextMatrix(0, 1) = "IdPro"
msGrid.TextMatrix(0, 2) = "Código"
msGrid.TextMatrix(0, 3) = "Nombre Producto"
msGrid.TextMatrix(0, 4) = "Cant"
msGrid.TextMatrix(0, 5) = "Precio C"
msGrid.TextMatrix(0, 6) = "Precio V"
msGrid.TextMatrix(0, 7) = "Impuesto"
msGrid.TextMatrix(0, 8) = "Subtotal"
msGrid.TextMatrix(0, 9) = "Descuento"
'recorre las celdas del titulo del grid y le da color
For I = 1 To msGrid.Cols - 1
msGrid.Row = 0
msGrid.Col = I 'va recorriendo las celdas de la primera fila
msGrid.CellBackColor = &H8C5828 'color azul para el fondo
msGrid.CellAlignment = flexAlignCenterCenter 'texto centrado
msGrid.CellForeColor = vbWhite 'color blanco para el texto
msGrid.CellFontBold = True 'Negrita
Next I
End Sub
Y Por ultimo se llama a LlenarGridProductos que se encarga de Llenar el Grid en caso de que se ingresaran producto y no se halla guardado la Factura de Compra. Esto es muy util si estamos ingresando una factura muy grande y se va la energía cuando abramos el formulario de compra volverá a cargar los productos que teníamos.
Sub LlenarGridProductos()
Sql = "SELECT tblDetalle_Compra.Id_detalle, tblDetalle_Compra.IdProducto, tblProductos.CodigoPro, tblProductos.NombrePro, tblDetalle_Compra.Cantidad_dv, tblDetalle_Compra.P_Costo_dv, tblDetalle_Compra.P_Venta_dv, tblProductos.Impuesto, 0 as Subtotal" _
& " FROM tblProductos INNER JOIN tblDetalle_Compra ON tblProductos.IdProducto = tblDetalle_Compra.IdProducto WHERE tblDetalle_Compra.Num_Factura = " & NumeroFactCompra
Call LlenarGrid(msGrid, Sql, Columnas)
msGrid.ColWidth(1) = 0 'ID
msGrid.ColWidth(2) = 0 'item
msGrid.ColWidth(3) = 900 'codigo
msGrid.ColWidth(4) = 4300 'nombre
msGrid.ColWidth(5) = 800 'cantidad
msGrid.ColWidth(6) = 1300 'precioc
msGrid.ColWidth(7) = 1300 'preciov
msGrid.ColWidth(8) = 1000 'imp
msGrid.ColWidth(9) = 1300 'subtotal
msGrid.ColWidth(10) = 0 'Desc
msGrid.TextMatrix(0, 2) = "IdPro"
msGrid.TextMatrix(0, 3) = "Código"
msGrid.TextMatrix(0, 4) = "Nombre Producto"
msGrid.TextMatrix(0, 5) = "Cant"
msGrid.TextMatrix(0, 6) = "Precio C"
msGrid.TextMatrix(0, 7) = "Precio V"
msGrid.TextMatrix(0, 8) = "% Imp"
msGrid.TextMatrix(0, 9) = "Subtotal"
msGrid.ColAlignment(5) = flexAlignCenterCenter
For Filas = 1 To msGrid.Rows - 1
Cantidad = msGrid.TextMatrix(Filas, 5)
PrecioVp = CCur(msGrid.TextMatrix(Filas, 6))
Subtotal = (Cantidad * PrecioVp) - DescuentoP
Impuesto = CCur(msGrid.TextMatrix(Filas, 7))
If G_Empresa_Regimen = "Común" And Impuesto > 0 Then '
TotalImpuesto = TotalImpuesto + Impuesto '
msGrid.TextMatrix(Filas, 6) = Format(msGrid.TextMatrix(Filas, 6), "currency")
msGrid.TextMatrix(Filas, 7) = Format(msGrid.TextMatrix(Filas, 7), "currency")
msGrid.TextMatrix(Filas, 8) = msGrid.TextMatrix(Filas, 8) & "%"
msGrid.TextMatrix(Filas, 9) = Format(Subtotal, "currency")
TotalVenta = TotalVenta + Subtotal
txtSubTotalFact.Text = Format((TotalVenta - TotalImpuesto), "currency")
txtTotalFactura.Text = Format(TotalVenta, "currency")
txtImpuestoFact.Text = Format(TotalImpuesto, "currency") '
NArticulos.Text = msGrid.Rows - 1
Sub LlenarGridProductos()
Dim Sql As String
Dim Columnas As Integer
Columnas = 9
Sql = "SELECT tblDetalle_Compra.Id_detalle, tblDetalle_Compra.IdProducto, tblProductos.CodigoPro, tblProductos.NombrePro, tblDetalle_Compra.Cantidad_dv, tblDetalle_Compra.P_Costo_dv, tblDetalle_Compra.P_Venta_dv, tblProductos.Impuesto, 0 as Subtotal" _
& " FROM tblProductos INNER JOIN tblDetalle_Compra ON tblProductos.IdProducto = tblDetalle_Compra.IdProducto WHERE tblDetalle_Compra.Num_Factura = " & NumeroFactCompra
Call LlenarGrid(msGrid, Sql, Columnas)
msGrid.ColWidth(0) = 0
msGrid.ColWidth(1) = 0 'ID
msGrid.ColWidth(2) = 0 'item
msGrid.ColWidth(3) = 900 'codigo
msGrid.ColWidth(4) = 4300 'nombre
msGrid.ColWidth(5) = 800 'cantidad
msGrid.ColWidth(6) = 1300 'precioc
msGrid.ColWidth(7) = 1300 'preciov
msGrid.ColWidth(8) = 1000 'imp
msGrid.ColWidth(9) = 1300 'subtotal
msGrid.ColWidth(10) = 0 'Desc
msGrid.TextMatrix(0, 2) = "IdPro"
msGrid.TextMatrix(0, 3) = "Código"
msGrid.TextMatrix(0, 4) = "Nombre Producto"
msGrid.TextMatrix(0, 5) = "Cant"
msGrid.TextMatrix(0, 6) = "Precio C"
msGrid.TextMatrix(0, 7) = "Precio V"
msGrid.TextMatrix(0, 8) = "% Imp"
msGrid.TextMatrix(0, 9) = "Subtotal"
msGrid.ColAlignment(5) = flexAlignCenterCenter
TotalVenta = 0
TotalDescuento = 0
TotalImpuesto = 0
For Filas = 1 To msGrid.Rows - 1
Cantidad = msGrid.TextMatrix(Filas, 5)
PrecioVp = CCur(msGrid.TextMatrix(Filas, 6))
Subtotal = (Cantidad * PrecioVp) - DescuentoP
Impuesto = CCur(msGrid.TextMatrix(Filas, 7))
If G_Empresa_Regimen = "Común" And Impuesto > 0 Then '
TotalImpuesto = TotalImpuesto + Impuesto '
End If '
msGrid.TextMatrix(Filas, 6) = Format(msGrid.TextMatrix(Filas, 6), "currency")
msGrid.TextMatrix(Filas, 7) = Format(msGrid.TextMatrix(Filas, 7), "currency")
msGrid.TextMatrix(Filas, 8) = msGrid.TextMatrix(Filas, 8) & "%"
msGrid.TextMatrix(Filas, 9) = Format(Subtotal, "currency")
TotalVenta = TotalVenta + Subtotal
Next Filas
txtSubTotalFact.Text = Format((TotalVenta - TotalImpuesto), "currency")
txtTotalFactura.Text = Format(TotalVenta, "currency")
txtImpuestoFact.Text = Format(TotalImpuesto, "currency") '
NArticulos.Text = msGrid.Rows - 1
Call CalcularTotalCompra
End Sub
Sub LlenarGridProductos()
Dim Sql As String
Dim Columnas As Integer
Columnas = 9
Sql = "SELECT tblDetalle_Compra.Id_detalle, tblDetalle_Compra.IdProducto, tblProductos.CodigoPro, tblProductos.NombrePro, tblDetalle_Compra.Cantidad_dv, tblDetalle_Compra.P_Costo_dv, tblDetalle_Compra.P_Venta_dv, tblProductos.Impuesto, 0 as Subtotal" _
& " FROM tblProductos INNER JOIN tblDetalle_Compra ON tblProductos.IdProducto = tblDetalle_Compra.IdProducto WHERE tblDetalle_Compra.Num_Factura = " & NumeroFactCompra
Call LlenarGrid(msGrid, Sql, Columnas)
msGrid.ColWidth(0) = 0
msGrid.ColWidth(1) = 0 'ID
msGrid.ColWidth(2) = 0 'item
msGrid.ColWidth(3) = 900 'codigo
msGrid.ColWidth(4) = 4300 'nombre
msGrid.ColWidth(5) = 800 'cantidad
msGrid.ColWidth(6) = 1300 'precioc
msGrid.ColWidth(7) = 1300 'preciov
msGrid.ColWidth(8) = 1000 'imp
msGrid.ColWidth(9) = 1300 'subtotal
msGrid.ColWidth(10) = 0 'Desc
msGrid.TextMatrix(0, 2) = "IdPro"
msGrid.TextMatrix(0, 3) = "Código"
msGrid.TextMatrix(0, 4) = "Nombre Producto"
msGrid.TextMatrix(0, 5) = "Cant"
msGrid.TextMatrix(0, 6) = "Precio C"
msGrid.TextMatrix(0, 7) = "Precio V"
msGrid.TextMatrix(0, 8) = "% Imp"
msGrid.TextMatrix(0, 9) = "Subtotal"
msGrid.ColAlignment(5) = flexAlignCenterCenter
TotalVenta = 0
TotalDescuento = 0
TotalImpuesto = 0
For Filas = 1 To msGrid.Rows - 1
Cantidad = msGrid.TextMatrix(Filas, 5)
PrecioVp = CCur(msGrid.TextMatrix(Filas, 6))
Subtotal = (Cantidad * PrecioVp) - DescuentoP
Impuesto = CCur(msGrid.TextMatrix(Filas, 7))
If G_Empresa_Regimen = "Común" And Impuesto > 0 Then '
TotalImpuesto = TotalImpuesto + Impuesto '
End If '
msGrid.TextMatrix(Filas, 6) = Format(msGrid.TextMatrix(Filas, 6), "currency")
msGrid.TextMatrix(Filas, 7) = Format(msGrid.TextMatrix(Filas, 7), "currency")
msGrid.TextMatrix(Filas, 8) = msGrid.TextMatrix(Filas, 8) & "%"
msGrid.TextMatrix(Filas, 9) = Format(Subtotal, "currency")
TotalVenta = TotalVenta + Subtotal
Next Filas
txtSubTotalFact.Text = Format((TotalVenta - TotalImpuesto), "currency")
txtTotalFactura.Text = Format(TotalVenta, "currency")
txtImpuestoFact.Text = Format(TotalImpuesto, "currency") '
NArticulos.Text = msGrid.Rows - 1
Call CalcularTotalCompra
End Sub
Ya para el Ingreso del producto, lo primero es la búsqueda del producto tanto por código como por el nombre.
Lo primero es inicializar los Campos del producto:
Sub LimpiarDatosProducto()
V_Editar_Producto = False
txtValorTotalPro.Text = 0
Sub LimpiarDatosProducto()
V_Editar_Producto = False
txtCodigoPro.Text = ""
txtNombrePro.Text = ""
txtCant_Pro.Text = 0
txtPCosto.Text = 0
txtPrecioV_Pro.Text = 0
txtValorTotalPro.Text = 0
txtNombrePro.SetFocus
End Sub
Sub LimpiarDatosProducto()
V_Editar_Producto = False
txtCodigoPro.Text = ""
txtNombrePro.Text = ""
txtCant_Pro.Text = 0
txtPCosto.Text = 0
txtPrecioV_Pro.Text = 0
txtValorTotalPro.Text = 0
txtNombrePro.SetFocus
End Sub
Seguimos con la búsqueda del producto para eso debemos tener las variables a nivel de formulario que son las siguientes:
Dim RecordSet_Producto As New ADODB.RecordSet
Dim CodigoProveedor
Dim RecordSet_Producto As New ADODB.RecordSet
Dim NumeroFactCompra
Dim IdProducto
Dim CodigoProveedor
Dim RecordSet_Producto As New ADODB.RecordSet
Dim NumeroFactCompra
Dim IdProducto
Esas variables van en la parte de mas arriba.
El Evento KeyUp del cuadro de texto txtNombrePro queda de la siguiente manera:
Private Sub txtNombrePro_KeyUp(KeyCode As Integer, Shift As Integer)
If Len(txtNombrePro.Text) > 2 Then
Call BuscarProductoNombre
lstListaRapida.Visible = False
If lstListaRapida.Visible = True Then
If txtNombrePro.Text = "" And KeyCode = 13 Then
'Call cmdGuardarFact_Click
Private Sub txtNombrePro_KeyUp(KeyCode As Integer, Shift As Integer)
If Len(txtNombrePro.Text) > 2 Then
Call BuscarProductoNombre
Else
lstListaRapida.Visible = False
End If
If KeyCode = 40 Then
If lstListaRapida.Visible = True Then
lstListaRapida.SetFocus
End If
End If
If txtNombrePro.Text = "" And KeyCode = 13 Then
'Call cmdGuardarFact_Click
End If
End Sub
Private Sub txtNombrePro_KeyUp(KeyCode As Integer, Shift As Integer)
If Len(txtNombrePro.Text) > 2 Then
Call BuscarProductoNombre
Else
lstListaRapida.Visible = False
End If
If KeyCode = 40 Then
If lstListaRapida.Visible = True Then
lstListaRapida.SetFocus
End If
End If
If txtNombrePro.Text = "" And KeyCode = 13 Then
'Call cmdGuardarFact_Click
End If
End Sub
Lo que notamos en el código anterior es que al escribir mas de 2 letras se llama al procedimiento BuscarProductoNombre este procedimiento queda de la siguiente manera:
Sub BuscarProductoNombre()
Sql = "Select Top 20 * From tblProductos Where NombrePro Like '" & txtNombrePro.Text & "%'"
Set RecordSet_Producto = ConexionADO.Execute(Sql)
If RecordSet_Producto.RecordCount > 0 Then
Do While Not RecordSet_Producto.EOF
lstListaRapida.AddItem RecordSet_Producto("NombrePro")
lstListaRapida.ItemData(Index) = RecordSet_Producto("IdProducto")
RecordSet_Producto.MoveNext
lstListaRapida.Visible = True
lstListaRapida.ListIndex = 0
lstListaRapida.Visible = False
Sub BuscarProductoNombre()
Dim Sql As String
Dim Index As Long
Sql = "Select Top 20 * From tblProductos Where NombrePro Like '" & txtNombrePro.Text & "%'"
Set RecordSet_Producto = ConexionADO.Execute(Sql)
If RecordSet_Producto.RecordCount > 0 Then
lstListaRapida.Clear
Index = 0
Do While Not RecordSet_Producto.EOF
lstListaRapida.AddItem RecordSet_Producto("NombrePro")
lstListaRapida.ItemData(Index) = RecordSet_Producto("IdProducto")
Index = Index + 1
RecordSet_Producto.MoveNext
Loop
lstListaRapida.Visible = True
lstListaRapida.ListIndex = 0
Else
lstListaRapida.Visible = False
End If
End Sub
Sub BuscarProductoNombre()
Dim Sql As String
Dim Index As Long
Sql = "Select Top 20 * From tblProductos Where NombrePro Like '" & txtNombrePro.Text & "%'"
Set RecordSet_Producto = ConexionADO.Execute(Sql)
If RecordSet_Producto.RecordCount > 0 Then
lstListaRapida.Clear
Index = 0
Do While Not RecordSet_Producto.EOF
lstListaRapida.AddItem RecordSet_Producto("NombrePro")
lstListaRapida.ItemData(Index) = RecordSet_Producto("IdProducto")
Index = Index + 1
RecordSet_Producto.MoveNext
Loop
lstListaRapida.Visible = True
lstListaRapida.ListIndex = 0
Else
lstListaRapida.Visible = False
End If
End Sub
Lo que se nota en el código anterior es que se hace una consulta a la tabla productos por nombre y que devuelve un máximo de 20 productos, luego se llena el control lstListaRapida con el nombre de estos producto y se hace visible, si no se encuentran productos no se muestra la lista.
Luego en la Lista Rápida usamos en evento KeyUp para que a medida que nos desplacemos en la lista llenemos los datos del producto:
Private Sub lstListaRapida_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Or KeyCode = 38 Then
IdProducto = lstListaRapida.ItemData(lstListaRapida.ListIndex)
Call DatosProducto(IdProducto)
lstListaRapida.Visible = False
lstListaRapida.Visible = False
Private Sub lstListaRapida_KeyUp(KeyCode As Integer, Shift As Integer)
Dim IdPro As Long
If KeyCode = 40 Or KeyCode = 38 Then
IdProducto = lstListaRapida.ItemData(lstListaRapida.ListIndex)
Call DatosProducto(IdProducto)
End If
If KeyCode = 27 Then
lstListaRapida.Visible = False
End If
If KeyCode = 13 Then
txtCant_Pro.SetFocus
lstListaRapida.Visible = False
End If
End Sub
Private Sub lstListaRapida_KeyUp(KeyCode As Integer, Shift As Integer)
Dim IdPro As Long
If KeyCode = 40 Or KeyCode = 38 Then
IdProducto = lstListaRapida.ItemData(lstListaRapida.ListIndex)
Call DatosProducto(IdProducto)
End If
If KeyCode = 27 Then
lstListaRapida.Visible = False
End If
If KeyCode = 13 Then
txtCant_Pro.SetFocus
lstListaRapida.Visible = False
End If
End Sub
En el código anterior para poder llenar los campos con los datos del producto se obtiene el Id del producto y luego se le pasa al procedimiento DatosProducto que se encarga de llenar los campos.
Sub DatosProducto(Id_Producto)
RecordSet_Producto.Filter = " IdProducto = " & Id_Producto
If RecordSet_Producto.RecordCount > 0 Then
txtCodigoPro.Text = !CodigoPro
txtNombrePro.Text = !NombrePro
txtPrecioV_Pro.Text = !PVenta1Pro
txtPCosto.Text = !PCostoPro
txtValorTotalPro.Text = !PCostoPro
Sub DatosProducto(Id_Producto)
IdProducto = Id_Producto
RecordSet_Producto.Filter = " IdProducto = " & Id_Producto
If RecordSet_Producto.RecordCount > 0 Then
With RecordSet_Producto
txtCodigoPro.Text = !CodigoPro
txtNombrePro.Text = !NombrePro
txtPrecioV_Pro.Text = !PVenta1Pro
txtPCosto.Text = !PCostoPro
txtValorTotalPro.Text = !PCostoPro
End With
End If
End Sub
Sub DatosProducto(Id_Producto)
IdProducto = Id_Producto
RecordSet_Producto.Filter = " IdProducto = " & Id_Producto
If RecordSet_Producto.RecordCount > 0 Then
With RecordSet_Producto
txtCodigoPro.Text = !CodigoPro
txtNombrePro.Text = !NombrePro
txtPrecioV_Pro.Text = !PVenta1Pro
txtPCosto.Text = !PCostoPro
txtValorTotalPro.Text = !PCostoPro
End With
End If
End Sub
Para la busqueda por código se utiliza el evento KeyUp del control txtCodigoPro:
Private Sub txtCodigoPro_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And txtCodigoPro.Text <> "" Then
Call BuscarProductoCodigo
If msGrid.Rows > 0 And KeyCode = 13 Then
Call cmdGuardarFact_Click
Private Sub txtCodigoPro_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And txtCodigoPro.Text <> "" Then
Call BuscarProductoCodigo
Exit Sub
End If
If msGrid.Rows > 0 And KeyCode = 13 Then
Call cmdGuardarFact_Click
End If
End Sub
Private Sub txtCodigoPro_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And txtCodigoPro.Text <> "" Then
Call BuscarProductoCodigo
Exit Sub
End If
If msGrid.Rows > 0 And KeyCode = 13 Then
Call cmdGuardarFact_Click
End If
End Sub
En el procedimiento anterior se llama al procedimiento BuscarProductoCodigo para hacer la consulta en la base de datos por el código del producto:
Sub BuscarProductoCodigo()
Sql = "Select * From tblProductos Where CodigoPro = '" & txtCodigoPro.Text & "'"
Set RecordSet_Producto = ConexionADO.Execute(Sql)
If RecordSet_Producto.RecordCount > 0 Then
Call DatosProducto(RecordSet_Producto("IdProducto"))
Sub BuscarProductoCodigo()
Dim Sql As String
Sql = "Select * From tblProductos Where CodigoPro = '" & txtCodigoPro.Text & "'"
Set RecordSet_Producto = ConexionADO.Execute(Sql)
If RecordSet_Producto.RecordCount > 0 Then
Call DatosProducto(RecordSet_Producto("IdProducto"))
txtCant_Pro.SetFocus
End If
End Sub
Sub BuscarProductoCodigo()
Dim Sql As String
Sql = "Select * From tblProductos Where CodigoPro = '" & txtCodigoPro.Text & "'"
Set RecordSet_Producto = ConexionADO.Execute(Sql)
If RecordSet_Producto.RecordCount > 0 Then
Call DatosProducto(RecordSet_Producto("IdProducto"))
txtCant_Pro.SetFocus
End If
End Sub
Si notamos después que obtenemos el Id del producto se lo pasamos al procedimiento que ya teníamos DatosProducto para que llene los campos del Producto.
Y para guardar el producto lo hacemos desde el evento KeyUP del campo txtCant_Pro:
Private Sub txtCant_Pro_KeyUp(KeyCode As Integer, Shift As Integer)
If txtCant_Pro.Text <> "" Then
Call cmdIngresarPro_Click
Private Sub txtCant_Pro_KeyUp(KeyCode As Integer, Shift As Integer)
If txtCant_Pro.Text <> "" Then
Call CalcularVTotal(0)
End If
If KeyCode = 13 Then
Call cmdIngresarPro_Click
End If
End Sub
Private Sub txtCant_Pro_KeyUp(KeyCode As Integer, Shift As Integer)
If txtCant_Pro.Text <> "" Then
Call CalcularVTotal(0)
End If
If KeyCode = 13 Then
Call cmdIngresarPro_Click
End If
End Sub
En el código anterior se llama al evento clic del botón IngresarPro:
Private Sub cmdIngresarPro_Click()
Private Sub cmdIngresarPro_Click()
Call IngresarProducto
End Sub
Private Sub cmdIngresarPro_Click()
Call IngresarProducto
End Sub
Y este a su vez llama a IngresarProducto:
Dim PrecioMinimo As Currency
Dim Valor_Impuesto As Currency
Dim Imp_TotalPro, precioVpro As Currency
If CCur(Me.txtPCosto.Text) = 0 Then
MsgBox "El precio Costo del articulo no puede ser cero", vbExclamation, "Error"
If CCur(txtPrecioV_Pro) = 0 Then
MsgBox "El precio venta del articulo no puede ser cero", vbExclamation, "Error"
If txtCant_Pro.Text = 0 Then
MsgBox "La cantidad del artículo no puede ser cero", vbExclamation, "Error"
If CCur(txtValorTotalPro) <= 0 Then
MsgBox "El total del producto no puede ser negativo ni igual a cero", vbCritical, "Error"
If G_Empresa_Regimen = "Común" And PorImpuesto_Producto > 0 Then
Num_Porc = (PorImpuesto_Producto / 100) + 1
Valor_Impuesto = CCur(txtValorTotalPro) / Num_Porc
mp_TotalPro = CCur(txtValorTotalPro) - Valor_Impuesto
If V_Editar_Producto = False Then
Sqlinsert = "Insert Into tblDetalle_Compra (Num_Factura, IdProducto, Cantidad_dv, P_Costo_dv, P_Venta_dv, Impuesto_dv) " _
& "VALUES (" & NumeroFactCompra & ", " & IdProducto & ", '" & txtCant_Pro & "', '" & txtPCosto & "', '" & CCur(txtPrecioV_Pro.Text) & "', '" & mp_TotalPro & "') "
ConexionADO.Execute Sqlinsert, , adExecuteNoRecords
SqlUpdate = "Update tblDetalle_Compra SET Cantidad_dv = '" & txtCant_Pro & "', P_Costo_dv = '" & CCur(PrecioC_Pro.Text) & "' , P_Venta_dv = '" & CCur(txtPrecioV_Pro.Text) & "', Descuento_dv = '" & txtDesuentoVPro & "' Where IdProducto = " & IdProducto
ConexionADO.Execute SqlUpdate, , adExecuteNoRecords
Call LimpiarDatosProducto
Sub IngresarProducto()
Dim PrecioMinimo As Currency
Dim Num_Proc As Double
Dim Valor_Impuesto As Currency
Dim Imp_TotalPro, precioVpro As Currency
If CCur(Me.txtPCosto.Text) = 0 Then
MsgBox "El precio Costo del articulo no puede ser cero", vbExclamation, "Error"
Exit Sub
End If
If CCur(txtPrecioV_Pro) = 0 Then
MsgBox "El precio venta del articulo no puede ser cero", vbExclamation, "Error"
Exit Sub
End If
If txtCant_Pro.Text = 0 Then
MsgBox "La cantidad del artículo no puede ser cero", vbExclamation, "Error"
Exit Sub
End If
If CCur(txtValorTotalPro) <= 0 Then
MsgBox "El total del producto no puede ser negativo ni igual a cero", vbCritical, "Error"
txtCant_Pro = 0
txtCant_Pro.SetFocus
End If
'Calcular Impuestos
mp_TotalPro = 0
If G_Empresa_Regimen = "Común" And PorImpuesto_Producto > 0 Then
Num_Porc = (PorImpuesto_Producto / 100) + 1
Valor_Impuesto = CCur(txtValorTotalPro) / Num_Porc
mp_TotalPro = CCur(txtValorTotalPro) - Valor_Impuesto
End If
If V_Editar_Producto = False Then
Sqlinsert = "Insert Into tblDetalle_Compra (Num_Factura, IdProducto, Cantidad_dv, P_Costo_dv, P_Venta_dv, Impuesto_dv) " _
& "VALUES (" & NumeroFactCompra & ", " & IdProducto & ", '" & txtCant_Pro & "', '" & txtPCosto & "', '" & CCur(txtPrecioV_Pro.Text) & "', '" & mp_TotalPro & "') "
ConexionADO.Execute Sqlinsert, , adExecuteNoRecords
Else
SqlUpdate = "Update tblDetalle_Compra SET Cantidad_dv = '" & txtCant_Pro & "', P_Costo_dv = '" & CCur(PrecioC_Pro.Text) & "' , P_Venta_dv = '" & CCur(txtPrecioV_Pro.Text) & "', Descuento_dv = '" & txtDesuentoVPro & "' Where IdProducto = " & IdProducto
ConexionADO.Execute SqlUpdate, , adExecuteNoRecords
End If
Call LlenarGridProductos
Call LimpiarDatosProducto
End Sub
Sub IngresarProducto()
Dim PrecioMinimo As Currency
Dim Num_Proc As Double
Dim Valor_Impuesto As Currency
Dim Imp_TotalPro, precioVpro As Currency
If CCur(Me.txtPCosto.Text) = 0 Then
MsgBox "El precio Costo del articulo no puede ser cero", vbExclamation, "Error"
Exit Sub
End If
If CCur(txtPrecioV_Pro) = 0 Then
MsgBox "El precio venta del articulo no puede ser cero", vbExclamation, "Error"
Exit Sub
End If
If txtCant_Pro.Text = 0 Then
MsgBox "La cantidad del artículo no puede ser cero", vbExclamation, "Error"
Exit Sub
End If
If CCur(txtValorTotalPro) <= 0 Then
MsgBox "El total del producto no puede ser negativo ni igual a cero", vbCritical, "Error"
txtCant_Pro = 0
txtCant_Pro.SetFocus
End If
'Calcular Impuestos
mp_TotalPro = 0
If G_Empresa_Regimen = "Común" And PorImpuesto_Producto > 0 Then
Num_Porc = (PorImpuesto_Producto / 100) + 1
Valor_Impuesto = CCur(txtValorTotalPro) / Num_Porc
mp_TotalPro = CCur(txtValorTotalPro) - Valor_Impuesto
End If
If V_Editar_Producto = False Then
Sqlinsert = "Insert Into tblDetalle_Compra (Num_Factura, IdProducto, Cantidad_dv, P_Costo_dv, P_Venta_dv, Impuesto_dv) " _
& "VALUES (" & NumeroFactCompra & ", " & IdProducto & ", '" & txtCant_Pro & "', '" & txtPCosto & "', '" & CCur(txtPrecioV_Pro.Text) & "', '" & mp_TotalPro & "') "
ConexionADO.Execute Sqlinsert, , adExecuteNoRecords
Else
SqlUpdate = "Update tblDetalle_Compra SET Cantidad_dv = '" & txtCant_Pro & "', P_Costo_dv = '" & CCur(PrecioC_Pro.Text) & "' , P_Venta_dv = '" & CCur(txtPrecioV_Pro.Text) & "', Descuento_dv = '" & txtDesuentoVPro & "' Where IdProducto = " & IdProducto
ConexionADO.Execute SqlUpdate, , adExecuteNoRecords
End If
Call LlenarGridProductos
Call LimpiarDatosProducto
End Sub
El resto de código como son el resaltado de colores de los campos y la validación de los campos de productos se pueden tomar de la tabla Ventas ejemplo:
Private Sub txtCant_Pro_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc(".") Then
If SoloNumeros(KeyAscii) = False Then
Private Sub txtCant_Pro_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc(".") Then
KeyAscii = Asc(",")
End If
If SoloNumeros(KeyAscii) = False Then
KeyAscii = 0
End If
End Sub
Private Sub txtCant_Pro_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc(".") Then
KeyAscii = Asc(",")
End If
If SoloNumeros(KeyAscii) = False Then
KeyAscii = 0
End If
End Sub
También te podría interesar:
Total Page Visits: 10299 - Today Page Visits: 2