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

No hay comentarios: