Curso de Software de Ventas Pt 50 – Compras – Ingresar Producto

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.

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Sub UltimoIDFactura()
NumeroFactCompra = UltimoIdTabla("tblCompras", "Id_Compra")
End Sub
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.

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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.

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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.

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Private Sub cmdIngresarPro_Click()
Call IngresarProducto
End Sub
Private Sub cmdIngresarPro_Click() Call IngresarProducto End Sub
Private Sub cmdIngresarPro_Click()
     Call IngresarProducto
End Sub

Y este a su vez llama a IngresarProducto:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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

 

 

Total Page Visits: 10301 - Today Page Visits: 4

Deja una respuesta