Sistema Bodega

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

SISTEMA BODEGA Nota: lo primero que debemos hacer es Crear una Carpeta en la unidad D:, luego activamos la Referencia

Pasos para Activar la Referencia : Clic en el Menú Proyecto Luego clic en Referencias Aparece una Ventana: Seleccionamos la Referencia Microsoft Activex Data Objects 2.0 Library

*************AHORA SI COMENZAMOS A PROGRAMAR*********** 1. Comenzamos Ingresando a Visual y Guardamos el Proyecto dentro de nuestra CARPETA creada en la Unidad D: 2. Ahora Añadimos un Módulo y Programamos

Public CONEXION As ADODB.Connection Sub main(ip As String, usu As String, pass As String, bd As String) On Error Resume Next Set CONEXION = New ADODB.Connection CONEXION.Provider = "sqloledb" CONEXION.ConnectionString = "initial catalog=" & bd & " ;data source=" & ip & ";user id =" & usu & ";password=" & pass CONEXION.CursorLocation = adUseClient CONEXION.Open 1

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

usuario_actual = "admin" End Sub

Sub Habilitar(bvalor As Boolean, frm As Form) frm.CmdAgregar.Enabled = Not bvalor frm.cmdModificar.Enabled = Not bvalor frm.cmdEliminar.Enabled = Not bvalor frm.cmdGuardar.Enabled = bvalor frm.cmdCancelar.Enabled = bvalor frm.Frame.Enabled = bvalor frm.Grid.Enabled = Not bvalor End Sub 3. En el Formulario Realizamos el Sgte Diseño, el formulario que se llame frmconexion

2

[email protected]

Prof. Joel de la Cruz Cruz •

http://privado-joel.blogspot.com/

[email protected]

Los controles tienen los sgtes nombres :

txtip , txtusu , txtpass, txtbd , cmdcancelar, cmdconectar •

Ahora programamos :

Private Sub Form_Load() Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub cmdconectar_Click() On Error Resume Next main txtip, txtusu, txtpass, txtbd savedpointer = Screen.MousePointer 'save mouse pointer Screen.MousePointer = 11 '11#=hourglass 'wait 2 Screen.MousePointer = savedpointer 'set to previous mouse pointer If Err = 0 Then frmAcceso.Show Unload Me Exit Sub End If MsgBox "Error al Conectarse, revise los datos..." End Sub Private Sub CmdCancelar_Click() If MsgBox("Seguro de abandonar la conexion", 36, "conexion al servidor") = vbYes Then End 3

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

End If End Sub

Nota : El formulario que bien acontinuación se llama FrmAcceso

txtusu txtpass lblm

Este Formulario va ah tener las sgtes Características : Objeto  FrmAcceso Propiedad  KeyPreview ( True ) Propiedad  StarUpPosition ( 2 - CenterScreen ) Objeto  txtpass 4

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

Propiedad  PasswordChar ( O ) , es la “ O ” en mayúscula Objeto  lblm Propiedad  BorderStyle ( 0 - none )

PROGRAMAMOS: Option Explicit Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Private Sub cmdaceptar_Click() Dim sql As String, rs As ADODB.Recordset Static c As Byte Set rs = New ADODB.Recordset sql = "select * from usuario Where login='" & txtusu & "' and password = '" & Trim(txtpass) & "'" rs.Open sql, CONEXION, 1, 1 If rs.RecordCount > 0 Then frmprincipal.Show Unload Me Else lblm = "Usuario o Contraseña Incorrectos...Intentelo Nuevamente" txtusu = "": txtpass = "": txtusu.SetFocus lblm = "Usuario o Contraseña Incorrectos... Intentelo Nuevamente" lblm.ForeColor = vbRed 5

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

c=c+1 If c > 2 Then lblm = "Acceso Denegado" lblm.Font.Bold = True lblm.Font.Size = 12 End End If End If End Sub Private Sub cmdcancelar_Click() frmconexion.Show Unload Me End Sub Private Sub Form_Load() Call Bloque_Mayusculas End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) Call Bloque_Mayusculas End Sub Sub Bloque_Mayusculas() Dim StateBlockMayus As Boolean StateBlockMayus = GetKeyState(vbKeyCapital) If StateBlockMayus Then lblm.Caption = "Tecla [BLOK MAYUS] activada, La activacion de la tecla [BLOK MAYUS] puede hacer que escribas la contraseña o usuario incorrectamente...!" lblm.ForeColor = &HFF 6

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

Else lblm.Caption = "Ingrese el usuario y contraseña que le corresponde, máximo 20 caracteres...!" lblm.ForeColor = &H404040 End If End Sub

Nota : Luego Insertamos un Formulario MDI, llamado frmprincipal que va ah tener las sgtes Características : Objeto  frmprincipal Propiedad Maximized)

7

 WindowState ( 2 -

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

* Ahora Creamos los Diferentes Menús que va ah ir en el frmprincipal

8

Prof. Joel de la Cruz Cruz

/* PROCEDIMIENTOS ALMACENADOS CLIENTE */ CREATE PROCEDURE agregar_cliente @cod_cli smallint, @nom_ape varchar(50), @dir_cli varchar(50), @tel_cli varchar(10), @email varchar(100), 9

http://privado-joel.blogspot.com/

[email protected]

Prof. Joel de la Cruz Cruz

@dni AS

http://privado-joel.blogspot.com/

char(8) begin tran insert cliente values(@cod_cli,@nom_ape,@dir_cli,@tel_cli,@email,@dni) if @@error <> 0 goto VerError commit tran return (0) VerError: print @@error rollback tran return -1

CREATE PROCEDURE modificar_cliente @cod_cli smallint, @nom_ape varchar(50), @dir_cli varchar(50), @tel_cli varchar(10), @email varchar(100), @dni char(8) AS begin tran 10

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

update cliente set nom_ape=@nom_ape,dir_cli=@dir_cli,tel_cli=@tel_cli,email=@email,dni=@dni where cod_cli=@cod_cli if @@error <> 0 goto VerError commit tran return (0) VerError: print @@error rollback tran return -1

CREATE PROCEDURE registros_cliente AS SELECT * FROM cliente CREATE PROCEDURE eliminar_cliente @cod_cli smallint AS begin tran delete from cliente where cod_cli=@cod_cli if @@error <> 0 goto VerError 11

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

commit tran return (0) VerError: print @@error rollback tran return -1

• Ahora Insertamos un formulario y le damos el nombre de: Frmcliente

12

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

• Ahora en nuestro Formulario llamado frmcliente utilzamos las sgtes Propiedades : BorderStyle 

1-Fixed Single

KeyPreview  true MDICHILD 

true

AHORA VAMOS A LOS MENUS QUE HEMOS INSERTADO EN NUESTRO FORMULARIO MDI •

Programamos en nuestro formulario MDI en el Submenu Cliente del Menu Archivo:

Private Sub menu11_Click() 13

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

frmcliente.Show End Sub

• Ahora Regresamos al Modulo para crear la Función mi Código es el que permite Generar el Código del Registro Public Function MiCodigo(tb As String, cp As String) As Integer Rem esta es una funcion para generar el codigo On Error Resume Next Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset 'Validamos la cantidad de registros existentes para generar el codigo rs.Open "Select IsNull(MAX(" & cp & "),0) From " & tb, CONEXION, 1, 1 MiCodigo = Val(rs(0)) + 1 End Function Public Function SoloNumeros(K As Integer) As Integer Rem esta funcion es para que solo ingrese numeros Const Cadena = "0123456789." SoloNumeros = IIf(InStr(Cadena, Chr(K)) > 0 Or K = 8 Or K = 13, K, 0) End Function

•

14

AHORA VAMOS A PROGRAMAR EN NUESTRO FORMULARIO frmcliente

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

Rem Creamos la variable rscliente de tipo recordset esto va en la parte general Dim rscliente As ADODB.Recordset Rem creamos la variable que nos va ah servir para agregar o modificar Rem cuando es SW = True es para agregar, SW = False para modificar Dim SW As Boolean Rem variable para el codigo Dim cod_cli As Integer Private Sub cmdAgregar_Click() Habilitar True, Me ' utilizo el procedimiento habilitar que esta en el modulo Call Limpiar ' utilizo el procedimiento limpiar que esta en formulario SW = True ' asigno a la variable sw el valor true, para poder agregar txtcliente.SetFocus 'ubico el enfoque en el control txtcliente End Sub Private Sub cmdcancelar_Click() Habilitar False, Me Call Limpiar cmdAgregar.SetFocus If rscliente.RecordCount > 0 Then Call Mostrar_Registros Else cmdModificar.Enabled = False cmdEliminar.Enabled = False End If End Sub Private Sub cmdEliminar_Click() Rem verificamos si cod_cli contiene algun registro seleccionado 15

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

If cod_cli > 0 Then If MsgBox("Desea realmente eliminar este registro", vbYesNo, "Atención") = vbYes Then CONEXION.Execute "Exec eliminar_cliente " & cod_cli & "" rscliente.Requery Grid.ReBind Call configurar_grid If rscliente.RecordCount > 0 Then Call Mostrar_Registros rscliente.MoveLast Else cmdModificar.Enabled = False cmdEliminar.Enabled = False End If End If Else MsgBox "Seleccione un Registro", vbOKOnly, "Sistema Bodega" Exit Sub End If End Sub Private Sub cmdGuardar_Click() 16

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

On Error Resume Next Rem ahora validamos el cliente If txtcliente.Text = "" Then MsgBox "Debe de Ingresar el Cliente ...", vbOKOnly, "Sistema Bodeba" txtcliente.SetFocus Exit Sub End If Rem ahora validamos el email si ah ingresado el telefono cuando ingresa un nuevo registro Rem utilizamos una variable de tipo recordset par validar el email Rem declaramos la variable para el email Dim rsemail As ADODB.Recordset If Len(txtemail.Text) > 0 And SW = True Then Rem verificamos el email cuando vamos agregar Set rsemail = New ADODB.Recordset Rem cod_cli ==> acuerdense que esta variable es para el codigo rsemail.Open "select * from cliente where email ='" & Trim(txtemail.Text) & "'", CONEXION, adOpenDynamic, adLockReadOnly If rsemail.RecordCount > 0 Then MsgBox "Debe de Ingresar el Email Correcto ...", vbOKOnly, "Sistema Bodeba" txtemail.SetFocus Exit Sub End If rs.Close ElseIf Len(txtemail.Text) > 0 And SW = False Then Rem verificamos el email cuando vamos a modificar Set rsemail = New ADODB.Recordset Rem cod_cli ==> acuerdense que esta variable es para el codigo 17

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

rsemail.Open "select * from cliente where email ='" & Trim(txtemail.Text) & "' and cod_cli not in ('" & cod_cli & "')", CONEXION, adOpenDynamic, adLockReadOnly If rsemail.RecordCount > 0 Then MsgBox "Debe de Ingresar el Email Correcto ...", vbOKOnly, "Sistema Bodeba" txtemail.SetFocus Exit Sub End If rs.Close Else Rem en caso que que el email no tenga 8 digitos txtemail.Text = "" End If Rem ahora validamos el dni si ah ingresado el dni, cuando ingresa un nuevo registro Rem utilizamos una variable de tipo recordset par validar el dni Rem declaramos la variable para el dni Dim rsdni As ADODB.Recordset If Len(txtdni.Text) = 8 And SW = True Then Set rsdni = New ADODB.Recordset rsdni.Open "select * from cliente where dni ='" & Trim(txtdni.Text) & "'", CONEXION, adOpenDynamic, adLockReadOnly If rsdni.RecordCount > 0 Then MsgBox "Debe de Ingresar el DNI Correcto ...", vbOKOnly, "Sistema Bodeba" txtdni.SetFocus Exit Sub End If rs.Close ElseIf Len(txtdni.Text) = 8 And SW = False Then Set rsdni = New ADODB.Recordset rsdni.Open "select * from cliente where dni ='" & Trim(txtdni.Text) & "' and cod_cli not in ('" & cod_cli & "')", CONEXION, adOpenDynamic, adLockReadOnly 18

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

[email protected]

If rsdni.RecordCount > 0 Then MsgBox "Debe de Ingresar el DNI Correcto ...", vbOKOnly, "Sistema Bodeba" txtdni.SetFocus Exit Sub End If rs.Close Else txtdni.Text = "" End If Rem ahora verificamos si vamos a Agregar o Modificar If SW = True Then Rem agregamos CONEXION.Execute "Exec agregar_cliente " & MiCodigo("cliente", "cod_cli") & ",'" & Trim(txtcliente.Text) & "','" & Trim(txtdireccion.Text) & "', '" & txttelefono.Text & "','" & Trim(txtemail.Text) & "','" & txtdni.Text & "'" Else Rem modificamos CONEXION.Execute "Exec modificar_cliente " & Val(cod_cli) & ",'" & Trim(txtcliente.Text) & "','" & Trim(txtdireccion.Text) & "', '" & txttelefono.Text & "','" & Trim(txtemail.Text) & "','" & txtdni.Text & "'" End If rscliente.Requery Grid.ReBind Grid.Refresh Call configurar_grid Habilitar False, Me Grid.SetFocus End Sub 19

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

Private Sub cmdModificar_Click() Rem verificamos si hay algun registro seleccionado para modificar If cod_cli <= 0 Then MsgBox "Seleccione un Registro", vbOKOnly, "Sistema Bodega" Exit Sub End If Habilitar True, Me SW = False txtcliente.SetFocus cod_cli = rscliente(0) 'es para poder obtener el codigo End Sub Private Sub Form_KeyPress(KeyAscii As Integer) Rem para cuando presione la tecla escape se oculte el formulario activo If KeyAscii = vbKeyEscape Then Unload Me cod_cli = 0 End If End Sub Private Sub Form_Load() Me.Left = 0 'lo ubica a la parte izquierda Me.Top = 0 'lo ubica a la parte superior Habilitar False, Me 'para desabilitar los controles Rem asigno a la variable rscliente un nuevo recordset Set rscliente = New ADODB.Recordset 20

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

Rem en esta parte ejecuto el procedimiento llamado registros_cliente, de una manera facil Rem conexion es la variable de la conexion a la base de datos Rem adOpenDynamic es el tipo de cursor Rem adLockReadOnly es el tipo de cerrejo rscliente.Open "Exec registros_cliente", CONEXION, adOpenDynamic, adLockReadOnly Rem verificamos si existe registros Rem si hay registros utilizamos el procedimiento configurar_grid If rscliente.RecordCount > 0 Then Set Grid.DataSource = rscliente Call configurar_grid End If Rem establecemos el tipo de estilo del grid cuando hacemos clic sobre el Grid.MarqueeStyle = 3 End Sub Sub configurar_grid() Rem este procedimiento nos permite configurar el grid Rem cabeceras,ancho,etc With Grid .Columns(1).Caption = "Cliente" .Columns(2).Caption = "Dirección" .Columns(3).Caption = "Telefono" .Columns(4).Caption = "Email" .Columns(5).Caption = "DNI" .Columns(1).Width = 3000 21

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

.Columns(2).Width = 3500 .Columns(3).Width = 1000 .Columns(4).Width = 2500 .Columns(5).Width = 800 .Columns(0).Visible = False End With End Sub Sub Limpiar() Rem procedimiento para limpiar el contenido de los controles txtcliente.Text = "": txtdireccion.Text = "" txtdni.Text = "": txtemail.Text = "" txttelefono.Text = "" End Sub Sub Mostrar_Registros() Rem procedimiento para mostrar los registros en los controles If rscliente.BOF Or rscliente.EOF Then Exit Sub cod_cli = Val(Grid.Columns(0).Value) 'rscliente (0) txtcliente = Grid.Columns(1).Value 'rscliente(1) txtdireccion = Grid.Columns(2).Value 'rscliente(2) txttelefono = Grid.Columns(3).Value 'rscliente(3) txtemail = Grid.Columns(4).Value 'rscliente(4) txtdni = Grid.Columns(5).Value 'rscliente(5) 22

[email protected]

Prof. Joel de la Cruz Cruz

http://privado-joel.blogspot.com/

End Sub Private Sub Grid_Click() Rem cuando hacemos clic mostramos los registros Rem siempre y cuando haya registros If rscliente.RecordCount > 0 Then Call Mostrar_Registros End If End Sub

Private Sub Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer) Rem este evento se utiliza cuando nos desplazamos por el grid con el teclado (teclas direccionales) Grid_Click End Sub Private Sub txtdni_KeyPress(KeyAscii As Integer) Rem utilizamos la funcion SoloNumeros que se encuentra en el Modulo KeyAscii = SoloNumeros(KeyAscii) End Sub Private Sub txttelefono_KeyPress(KeyAscii As Integer) Rem utilizamos la funcion SoloNumeros que se encuentra en el Modulo KeyAscii = SoloNumeros(KeyAscii) End Sub

23

[email protected]