Curso de Software de Ventas Parte 31, Ventana de Ventas 6 – Precios de Venta

En este vídeo se trabaja la parte de los precios de venta, esta nos va a permitir seleccionar varios precios de venta para cada producto y según el cliente.

Colabora y Suscribete a mi canal de   

Lo primero es agregar un ComboBox que 3 item: Precio Venta 1,  Precio Venta 2, Precio Venta 3 como se ve en la siguiente imagen:

El control ComboBox se le cambia el nombre a cmbPrecios y en su propiedad clic el código que tendrá es el siguiente :

Private Sub cmbPrecios_Click()
    If RecordSet_Producto.State = 0 Then
       Exit Sub
    End If
    
    Select Case cmbPrecios.ListIndex
    Case 0
         txtPrecioV_Pro.Text = RecordSet_Producto!PVenta1Pro
    Case 1
         txtPrecioV_Pro.Text = Precio2_Producto
    Case 2
         txtPrecioV_Pro.Text = Precio3_Producto
    End Select
    Call CalcularVTotal(0)
End Sub

Si se nota en el código, lo primero es validar que el RecordSet_Producto este abierto para que no genere error al sacar el precio de venta 1 del producto.

Lo siguiente es usar un Select Case para tomar el precio dependiendo del Indice de item seleccionado del ComboBox.

Por ultimo se calcula el Valor total con el precio seleccionado.

Lo siguiente es agregar esta misma lista en el formulario de Clientes para que podamos escoger el precio con que se le facturara al cliente, que puede ser con Todos, o con cualquiera de los 3.

Si se escoge uno de los 3 en la ventana de ventas se deshabilitará el ComboBox y se dejara predeterminado el precio ya seleccionado para el cliente.

Después de colocar la lista en el Load del formulario de Cliente se predetermina el ListIndex = 0 y antes del Procedimiento LlenarDatosCliente de la siguiente manera:

cmbPrecios.ListIndex = 0
Call LLenarDatosCliente

Lo siguiente es crear un campo en la base de datos en la tabla tblClientes llamado PrecioVenta de tipo Entero.

Luego modificamos el código de guardar Cliente y Modificar Cliente para agregar el nuevo campo.

Sub GuardarCliente()
    
    If txtRazonS.Text = "" Then
       MsgBox "Error - El Campo Nombre / Razón Social no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    If txtNitCliente.Text = "" Then
       MsgBox "Error - El Campo Identifiación no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    If txtTelefonosCliente.Text = "" Then
       MsgBox "Error - El Campo Teléfonos no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    If txtDireccionCliente.Text = "" Then
       MsgBox "Error - El Campo Dirección no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    If txtFechaCumple.Text = "" Then
       MsgBox "Error - El Campo Fecha de Nacimiento no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    If IsDate(txtFechaCumple.Text) = False Then
       MsgBox "Error - El Campo Fecha de Nacimiento no tiene una fecha válida", vbExclamation, "Error"
       Exit Sub
    End If
    If txtEmail.Text = "" Then
       MsgBox "Error - El Campo Email no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    If txtCupo.Text = "" Then
       MsgBox "Error - El Campo Cupo Autorizado no puede estar vacío", vbExclamation, "Error"
       Exit Sub
    End If
    
    If CodigoCliente = 0 Then
       IdCliente = UltimoIdTabla("tblClientes", "IdCliente")
       
       If chkFactVenciM.Value = 1 Then
          FacVec = "S"
       Else
          FacVec = "N"
       End If
       
       Sql = "Insert Into tblClientes (IdCliente, NombreApellidos_cli, Identificacion_cli, Telefonos_cli, Direccion_cli, Fecha_Naci_cli, Email_cli, CupoAutorizado_cli,  FacturarVecidos, PrecioVenta ) Values (" _
            & IdCliente & ", '" & txtRazonS & "', '" & txtNitCliente & "', '" & txtTelefonosCliente & "', '" & txtDireccionCliente & "', '" & txtFechaCumple & "', '" & txtEmail & "', '" & txtCupo & "', '" & FacVec & "', " & cmbPrecios.ListIndex & ")"
            
       ConexionADO.Execute Sql
       MsgBox "Cliente Guardado", vbInformation, "Guardar"
    Else
       Sql = "Update tblClientes SET NombreApellidos_cli = '" & txtRazonS & "', Identificacion_cli = '" & txtNitCliente & "', Telefonos_cli = '" & txtTelefonosCliente & "', Direccion_cli = '" & txtDireccionCliente & "', Fecha_Naci_cli = '" & txtFechaCumple & "', Email_cli = '" & txtCupo & "', CupoAutorizado_cli = '" & txtCupo & "',  FacturarVecidos = '" & FacVec & "', PrecioVenta = " & cmbPrecios.ListIndex & " Where IdCliente = " & CodigoCliente
       ConexionADO.Execute Sql
       MsgBox "Cliente Actualizado", vbInformation, "Guardar"
       
    End If
End Sub

Se modifico el SQL de Insertar y el de Update al final

Tambien hay que modificar el Procedimiento LLenarDatosCliente para que cargue el PrecioVenta guardado y si no tiene que cargue que recibo Todos.

Sub LLenarDatosCliente()
    Dim RecorsetTemp As New ADODB.RecordSet
    
    Sql = "Select * From tblClientes Where IdCliente = " & CodigoCliente
    Set RecorsetTemp = ConexionADO.Execute(Sql)
    
    If RecorsetTemp.RecordCount > 0 Then
       txtRazonS.Text = RecorsetTemp("NombreApellidos_cli")
       txtNitCliente = RecorsetTemp("Identificacion_cli")
       txtTelefonosCliente = RecorsetTemp("Telefonos_cli")
       txtDireccionCliente = RecorsetTemp("Direccion_cli")
       txtFechaCumple = RecorsetTemp("Fecha_Naci_cli")
       txtEmail = RecorsetTemp("Email_cli")
       txtCupo = RecorsetTemp("CupoAutorizado_cli")
       FacV = RecorsetTemp("FacturarVecidos")
       If FacV = "S" Then
          chkFactVenciM.Value = 1
       Else
          chkFactVenciM.Value = 0
       End If
       'Lines Nuevas
       If IsNull(RecorsetTemp("PrecioVenta")) = True Then
          cmbPrecios.ListIndex = 0
       Else
          cmbPrecios.ListIndex = RecorsetTemp("PrecioVenta")
       End If
    End If
    Call DesactivarCampos
    
End Sub

Lo nuevo que se agrego fueron las siguientes Lineas:

'Lines Nuevas
If IsNull(RecorsetTemp("PrecioVenta")) = True Then
   cmbPrecios.ListIndex = 0
Else
   cmbPrecios.ListIndex = RecorsetTemp("PrecioVenta")
End If

En los procedimiento de Desactivar y Activar hay que agregar el el control cmbPrecios.Enabled = False y cmbPrecios.Enabled = True respecticvamente

Sub DesactivarCampos()
     txtRazonS.Enabled = False
     txtNitCliente.Enabled = False
     txtTelefonosCliente.Enabled = False
     txtDireccionCliente.Enabled = False
     txtFechaCumple.Enabled = False
     txtEmail.Enabled = False
     txtCupo.Enabled = False
     Me.chkFactVenciM.Enabled = False
     cmbPrecios.Enabled = False 'Linea Nueva
End Sub

Sub ActivarCampos()
     txtRazonS.Enabled = True
     txtNitCliente.Enabled = True
     txtTelefonosCliente.Enabled = True
     txtDireccionCliente.Enabled = True
     txtFechaCumple.Enabled = True
     txtEmail.Enabled = True
     txtCupo.Enabled = True
     chkFactVenciM.Enabled = True
     cmbPrecios.Enabled = True 'Linea Nueva
End Sub

Y por ultimo hay que modificar en la ventana de Ventas se modifica el Procedimiento SeleccionarCliente:

Sub SeleccionarCliente(Codigo As Long, Indentifi As String, Nombre As String, Telefono As String, Cupo As Currency, PrecioVenta As Integer)
    CodigoCliente = Codigo
    txtIdentificacion_Cli.Text = Indentifi
    txtNombre_Cli.Text = Nombre
    txtTelefono_cli.Text = Telefono
    txtCuposA.Text = Cupo
    If PrecioVenta < 2 Then                   'Lineas nuevas
       cmbPrecios.ListIndex = 0               'Lineas nuevas
    Else
       cmbPrecios.ListIndex = PrecioVenta - 1 'Lineas nuevas
    End If
    If PrecioVenta > 0 Then
       cmbPrecios.Enabled = False
    Else
       cmbPrecios.Enabled = True
    End If
End Sub

Luego de esto hay que modificar en la Ventana de Buscar Cliente en el Procedimiento BuscarClientes:

Sub BuscarClientes()
    Dim Sql As String
    Dim Filtro As String
    Dim Columnas As Integer
    'IdUsuario,usuario,password_us,identificacion,nombres_apellidos,IdNivelUsuario
    Tipo = cmdTipoBusqueda.ListIndex
    Filtro = ""
    Select Case Tipo
           Case 0:
                Filtro = " NombreApellidos_cli like '%" & txtFiltro.Text & "%' "
           Case 1:
                Filtro = " Identificacion_cli like '%" & txtFiltro.Text & "%' "
           Case 2:
                Filtro = " IdCliente like '%" & txtFiltro.Text & "%' "
    End Select
    Sql = "Select IdCliente, NombreApellidos_cli, Identificacion_cli, Telefonos_cli, CupoAutorizado_cli, PrecioVenta From tblClientes Where " & Filtro
    Columnas = 4
    Call LlenarGrid(msGrid, Sql, Columnas)
    
    
    msGrid.ColWidth(0) = 0
    msGrid.ColWidth(1) = 1100
    msGrid.ColWidth(2) = 3500
    msGrid.ColWidth(3) = 1800
    msGrid.ColWidth(4) = 1800
    msGrid.ColWidth(5) = 0
    msGrid.ColWidth(6) = 0

    msGrid.TextMatrix(0, 1) = "ID"
    msGrid.TextMatrix(0, 2) = "Razon Social / Nombre"
    msGrid.TextMatrix(0, 3) = "Identificación"
    msGrid.TextMatrix(0, 4) = "Teléfonos"
    msGrid.TextMatrix(0, 5) = "Cupo"
    msGrid.TextMatrix(0, 6) = "PrecioVenta" 'Linea Nueva
    
End Sub

Se modifico la consulta agregando un campo más y se agrego una columna oculta al grid para el PrecioVenta.

Se modifica el evento clic del botón seleccionar de la ventana Buscar Cliente:

Private Sub cmdSeleccionar_Click()
    Dim Codigo As Long
    Dim Identifi As String
    Dim Nombre As String
    Dim Telefono As String
    Dim Cupo  As Currency
    Dim PrecioVenta As Integer
    Codigo = msGrid.TextMatrix(msGrid.Row, 1)
    If Codigo <> 0 Then
        If glob_FormularioSolicBuscarCli = "frmVentas" Then
           Nombre = msGrid.TextMatrix(msGrid.Row, 2)
           Identifi = msGrid.TextMatrix(msGrid.Row, 3)
           Telefono = msGrid.TextMatrix(msGrid.Row, 4)
           Cupo = msGrid.TextMatrix(msGrid.Row, 5)
           PrecioVenta = msGrid.TextMatrix(msGrid.Row, 6)
           If IsNull(PrecioVenta) = True Then
              PrecioVenta = 0
           End If
           Call frmVentas.SeleccionarCliente(Codigo, Identifi, Nombre, Telefono, Cupo, PrecioVenta)
           Unload Me
        End If
    End If
    
End Sub

Y por últomo se modifica el Procedimiento de DatosProducto en la ventana de Ventas:

Sub DatosProducto(IdProducto)
    IdProducto = Id_Producto
    RecordSet_Producto.Filter = " IdProducto = " & IdProducto
    If RecordSet_Producto.RecordCount > 0 Then
       With RecordSet_Producto
            txtCodigoPro.Text = !CodigoPro
            txtNombrePro.Text = !NombrePro
            txtPrecioV_Pro.Text = !PVenta1Pro
            If cmbPrecios.ListIndex = 0 Then     'se modifico esta linea
               txtPrecioV_Pro.Text = !PVenta1Pro
            ElseIf cmbPrecios.ListIndex = 1 Then
               txtPrecioV_Pro.Text = Format(!PVenta2Pro, "currency")
            Else
               txtPrecioV_Pro.Text = Format(!PVenta3Pro, "currency")
            End If
            txtPrecioMinimoPro.Text = Format(!PMinimoPro, "currency")
            txtExistPro.Text = !ExistPro
            Precio2_Producto = !PVenta2Pro
            Precio3_Producto = !PVenta3Pro
       End With
    End If
End Sub

Hay que corregir un en el evento KeyUp de la Lista Rapida que al presionar hacia arriba la tecla no es 39 sino 38, el código quedaría de la siguiente manera:

Private Sub lstListaRapida_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim IdPro As Long
    
    If KeyCode = 40 Or KeyCode = 38 Then
       IdPro = lstListaRapida.ItemData(lstListaRapida.ListIndex)
       Call DatosProducto(IdPro)
    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

Apóyanos siguiendo las redes sociales:

Suscribete a Youtube

Siguenos en Twitter

Siguenos en Facebook