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.
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:
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.
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() 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 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 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 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() 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) 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) 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 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() 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 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() Call IngresarProducto End Sub
Y este a su vez llama a IngresarProducto:
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 KeyAscii = Asc(",") End If If SoloNumeros(KeyAscii) = False Then KeyAscii = 0 End If End Sub