jueves, 29 de marzo de 2007
Codigo y Formulario Modificado por mi (gensar)
Public cnAgenda As Connection
Public FlagDatosPersonales As Boolean
Public rsDatosPersonales As Recordset
Private Sub CmdActionButton_Click(Index As Integer)
'1 Mover al Inicio
'2 Mover al Anterior
'3 Mover al Siguiente
'4 Mover al Final
Select Case Index
Case 0 'Mover al Inicio
Me.rsDatosPersonales.MoveFirst
Case 1 'Mover al anterior
If Me.rsDatosPersonales.BOF = True Then
Me.rsDatosPersonales.MoveFirst
Else
Me.rsDatosPersonales.MovePrevious
End If
Case 2 'Mover al Siguiente
If Me.rsDatosPersonales.EOF = True Then
Me.rsDatosPersonales.MoveLast
Else
Me.rsDatosPersonales.MoveNext
End If
Case 3 'Mover al Final
Me.rsDatosPersonales.MoveLast
End Select
End Sub
Private Sub CmdAgregar_Click()
If Me.TxtNombre.Text = "" Or Me.TxtApepat.Text = "" Or Me.TxtApemat.Text = "" Or Me.TxtDireccion.Text = "" Then
MsgBox "no deje espacios en blanco"
Else
FrmMain.rsDatosPersonales.AddNew
FrmMain.rsDatosPersonales!nompersona = Me.TxtNombre.Text
FrmMain.rsDatosPersonales!apepat = Me.TxtApepat.Text
FrmMain.rsDatosPersonales!apemat = Me.TxtApemat.Text
FrmMain.rsDatosPersonales!direccion = Me.TxtDireccion.Text
FrmMain.rsDatosPersonales.Requery
End If
End Sub
Private Sub CmdBuscar_Click()
Select Case Me.CmbBuscar.Text
Case "Nombre"
FrmMain.rsDatosPersonales.MoveFirst
FrmMain.Buscar_DatosPersonales Me.TxtBuscar, 1
Case "Apellido Paterno"
FrmMain.rsDatosPersonales.MoveFirst
FrmMain.Buscar_DatosPersonales Me.TxtBuscar, 2
Case "Dirección"
FrmMain.rsDatosPersonales.MoveFirst
FrmMain.Buscar_DatosPersonales Me.TxtBuscar, 4
End Select
End Sub
Private Sub CmdEliminar_Click()
If Me.rsDatosPersonales.RecordCount > 0 Then
Me.rsDatosPersonales.Delete
Me.rsDatosPersonales.Requery
Else
MsgBox "Seleccione algun dato a eliminar"
End If
End Sub
Private Sub CmdModificar_Click()
If Me.TxtNombre.Text = "" Or Me.TxtApepat.Text = "" Or Me.TxtApemat.Text = "" Or Me.TxtDireccion.Text = "" Then
MsgBox "no deje espacios en blanco"
Else
FrmMain.rsDatosPersonales!nompersona = Me.TxtNombre.Text
FrmMain.rsDatosPersonales!apepat = Me.TxtApepat.Text
FrmMain.rsDatosPersonales!apemat = Me.TxtApemat.Text
FrmMain.rsDatosPersonales!direccion = Me.TxtDireccion.Text
FrmMain.rsDatosPersonales.Requery
End If
End Sub
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error GoTo horroroso
Me.TxtNombre.Text = Me.rsDatosPersonales!nompersona
Me.TxtApepat.Text = Me.rsDatosPersonales!apepat
Me.TxtApemat.Text = Me.rsDatosPersonales!apemat
Me.TxtDireccion.Text = Me.rsDatosPersonales!direccion
horroroso:
If Err.Number = 3021 Then
Exit Sub
End If
End Sub
Private Sub Form_Load()
Set cnAgenda = New Connection
With cnAgenda
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\AgendaInfoUnsaNoche\BaseDatos\Agenda.mdb;Persist Security Info=False"
.Open
End With
Set rsDatosPersonales = New Recordset
With rsDatosPersonales
.Source = "Select * from Tb_DatosPersonales"
.ActiveConnection = cnAgenda
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open Options:=adCmdText
End With
Screen.MousePointer = vbDefault
Set FrmMain.DataGrid1.DataSource = FrmMain.rsDatosPersonales
Me.CmbBuscar.AddItem "Nombre", 0
Me.CmbBuscar.AddItem "Apellido Paterno", 1
Me.CmbBuscar.AddItem "Dirección", 2
End Sub
Public Sub Buscar_DatosPersonales(Buscado As String, IndiceLista As Integer)
Dim Criterio As String
If Buscado <> "" Then
Select Case IndiceLista
Case 0
Criterio = "CodPersona Like '" & Buscado & "'"
BuscarPrimer_DatosPersonales Criterio
Case 1
Criterio = "NomPersona Like '*" & Buscado & "*'"
BuscarPrimer_DatosPersonales Criterio
Case 2
Criterio = "ApePat Like '*" & Buscado & "*'"
BuscarPrimer_DatosPersonales Criterio
Case 3
Criterio = "ApeMat Like '*" & Buscado & "*'"
BuscarPrimer_DatosPersonales Criterio
Case 4
Criterio = "Direccion Like '*" & Buscado & "*'"
BuscarPrimer_DatosPersonales Criterio
End Select
Else
MsgBox "Ingrese alguna palabra para buscar", vbOKOnly, "Error"
End If
End Sub
Private Sub BuscarPrimer_DatosPersonales(Criterio As String)
' Buscar desde el siguiente registro a la posición actual
FlagDatosPersonales = True
FrmMain.rsDatosPersonales.MoveNext
If Not FrmMain.rsDatosPersonales.EOF Then
FrmMain.rsDatosPersonales.Find Criterio
End If
If FrmMain.rsDatosPersonales.EOF Then
FrmMain.rsDatosPersonales.MoveFirst
' Buscar desde el principio
FrmMain.rsDatosPersonales.Find Criterio
If FrmMain.rsDatosPersonales.EOF Then
FrmMain.rsDatosPersonales.MoveLast
FlagDatosPersonales = False
MsgBox ("No encuentro ese nombre")
End If
End If
End Sub
Function borrar()
Me.TxtNombre
End Function
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Me.MnuFunciones
End If
End Sub
Private Sub MnuAgregar_Click()
If Me.TxtNombre.Text = "" Or Me.TxtApepat.Text = "" Or Me.TxtApemat.Text = "" Or Me.TxtDireccion.Text = "" Then
MsgBox "no deje espacios en blanco"
Else
FrmMain.rsDatosPersonales.AddNew
FrmMain.rsDatosPersonales!nompersona = Me.TxtNombre.Text
FrmMain.rsDatosPersonales!apepat = Me.TxtApepat.Text
FrmMain.rsDatosPersonales!apemat = Me.TxtApemat.Text
FrmMain.rsDatosPersonales!direccion = Me.TxtDireccion.Text
FrmMain.rsDatosPersonales.Requery
End If
End Sub
Private Sub MnuEliminar_Click()
If Me.rsDatosPersonales.RecordCount > 0 Then
Me.rsDatosPersonales.Delete
Me.rsDatosPersonales.Requery
Else
MsgBox "Seleccione algun dato a eliminar"
End If
End Sub
Suscribirse a:
Enviar comentarios (Atom)
No hay comentarios:
Publicar un comentario