Hola aquí te dejo el programa con su respectiva explicacion:
-----------------------------------------------------------------------
La base de datos acces debe tener los siguientes campos, y el formato de los campos debe ser el descripto mas abajo, y respecto del tamaño puede ser ese o el que vos dispongas.
-----------------------------------------------------------------------
id_catedratico autonumérico
numero_empleado Numero
status_actual texto 255
fecha_de_ingreso fecha
fecha_de_baja fecha
nombre_completo texto 255
fecha_de_nacimiento fecha
lugar_de_nacimiento texto 255
nacionalidad texto 40
estado_civil texto 40
codigo_postal texto 50
telefono_domicilio texto 60
telefono_celular texto 60
correo_electronico texto 255
foto texto 255
-----------------------------------------------------------------------
En el formulario tienes que ingresar lo siguiente:
-----------------------------------------------------------------------
1) Frame2 con el captión "Datos Curriculares"
Dentro del Frame2, pones lo siguiente:
Label1 caption "Id Catedrático" y debajo el text1
Label2 caption "Número catedrático" y debajo el text2
Label3 caption "Status Actual" y debajo el text3
Label4 caption "Fecha Ingreso" y debajo el text4
Label5 caption "Fecha de baja" y debajo el text5
Label6 caption "Apellido y Nombres" y debajo el text6
2)Frame 3 con el captión "Información Personal"
dentro del frame3, pones lo siguiente:
Label7 caption "Fecha de Nacimiento" y debajo el text7
Label8 caption "Lugar de Nacimiento" y debajo el text8
Label10 caption "Nacionalidad" y debajo el text9
Label9 caption "Estado Civil" y debajo el text10
Label12 caption "Cód.Postal" y debajo el text11
Label11 caption "Teléfono Domiciliario" y debajo el text12
Label13 caption "Teléfono Celular" y debajo el text13
Label14 caption "Correo Electrónico" y debajo el text14
3) Un Picture1 con autosize a falso
4) Un command7 con el captión "Cargar imagen" y visible a false
5) Un Frame1 con el captión "Comandos"
Dentro del Frame 1 los siguientes Commandbutton
Command1 con el captión "Inicio"
Command2 con el captión "Anterior"
Command3 con el captión "Siguiente"
Command4 con el captión "Final"
Command5 con el captión "Nuevo"
Command6 con el captión "Borrar"
Command8 con el captión "Editar"
Command9 con el captión "Buscar"
-----------------------------------------------------------------------
Bueno ahora te dejo el código debidamente explicado.
-----------------------------------------------------------------------
Option Explicit
' Objeto para acceder directamente a la base usando código
Private cnn As ADODB.Connection
' WithEvents permite tener acceso a los a los mismos eventos que con el ADO DataControl
Private WithEvents rst As ADODB.Recordset
'variable para la función -cargar_Imagen-
Private foto As IPictureDisp
'variable que se utiliza en el evento de crear un nuevo registro
Dim nuevo As Boolean
Private Sub Command1_Click()
On Error Resume Next
'al primer registro
rst.MoveFirst
'llena los textbox con el contenido del registro indicado
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
'al registro anterior
rst.MovePrevious
'Si se sobrepasa el inicio de la base, se mueve el puntero al primer registro
If rst.BOF Then
rst.MoveFirst
End If
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Command3_Click()
On Error Resume Next
'al registro siguiente
rst.MoveNext
'Si se sobrepasa el final de la base, se mueve el puntero al ultimo registro
If rst.EOF Then
rst.MoveLast
End If
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Command4_Click()
On Error Resume Next
'al ultimo registro
rst.MoveLast
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Command5_Click()
On Error Resume Next
'Si se presiona este comando se autoriza un nuevo registro
'Se mueve el foco al text 1
'la variable boolean nuevo se pone a True
'Se renombra el caption del comando Nuevo
'Se hace visible el comando -cargar imagen-
'Se vacían todos los textbox con excepción del primero que
'corresponde al id_catedratico que es autonumérico
If nuevo = False Then
Text1.SetFocus
nuevo = True
Command5.Caption = "Grabar nuevo"
Command7.Visible = True
ocultarcontroles False
rst.AddNew
Text1.Text = rst!id_catedratico
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Else
Command5.Caption = "Nuevo"
Command7.Visible = False
nuevo = False
With rst
.Fields("numero_empleado") = Text2
.Fields("status_actual") = Text3
.Fields("fecha_de_ingreso") = Text4
.Fields("fecha_de_baja") = Text5
.Fields("nombre_completo") = Text6
.Fields("fecha_de_nacimiento") = Text7
.Fields("lugar_de_nacimiento") = Text8
.Fields("nacionalidad") = Text9
.Fields("estado_civil") = Text10
.Fields("codigo_postal") = Text11
.Fields("telefono_domicilio") = Text12
.Fields("telefono_celular") = Text13
.Fields("correo_electronico") = Text14
End With
rst.Update
rst.MoveLast
mostrarcontroles False
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End If
End Sub
Private Sub Command6_Click()
On Error Resume Next
' Elimina el registro actual
rst.Delete
' Mueve el puntero al siguiente registro
rst.MoveNext
' Si no puede mover al siguiente, se posiciona en el primer registro.
If rst.EOF Then
rst.MoveLast
End If
'muestra el contenido del recordset en los textbox
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Command7_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = " Seleccionar imagen"
.Filter = "BMP|*.bmp|JPEG|*.jpeg|GIF|*.gif|JPG|*.jpg|Todos|*.*"
.ShowOpen
If .FileName = "" Then
Exit Sub
Else
'Carga en nombre el path donde se ejecuta el programa, el directorio especificado
'y el nombre y la extensión de la imagen seleccionada.
Dim nombre As String: nombre = App.Path & "\imagenes\" & .FileTitle
'Copia la imagen seleccionada en el cuadro de dialogo en el lugar que dice la variable -nombre-
Call FileCopy(CommonDialog1.FileName, nombre)
'actualiza el campo -foto- con el valor de la variable -nombre-
rst!foto = nombre
'actualiza el picture1 con la nueva imagen seleccionada.
Call cargar_Imagen(Picture1, nombre)
End If
End With
End Sub
Private Sub Command8_Click()
On Error Resume Next
'comienza el ciclo de edición
If Command7.Visible = False Then
Command7.Visible = True
'renombra el captión del command8 de edición
Command8.Caption = "Grabar cambios"
'oculta los demás controles para dirigir la atención a lo que se está editando.
ocultarcontroles True
Else
'Cuando se vuelve a presionar este boton con el captión renombrado
'Se guarda el contenido de las cajas de texto y en el mismo recordset apuntado
With rst
.Fields("numero_empleado") = Text2
.Fields("status_actual") = Text3
.Fields("fecha_de_ingreso") = Text4
.Fields("fecha_de_baja") = Text5
.Fields("nombre_completo") = Text6
.Fields("fecha_de_nacimiento") = Text7
.Fields("lugar_de_nacimiento") = Text8
.Fields("nacionalidad") = Text9
.Fields("estado_civil") = Text10
.Fields("codigo_postal") = Text11
.Fields("telefono_domicilio") = Text12
.Fields("telefono_celular") = Text13
.Fields("correo_electronico") = Text14
.Update
End With
'Se renombra nuevamente el captión del comand8
Command8.Caption = "Editar"
'se esconde el command7 que permite editar las imagenes
Command7.Visible = False
'se muestran los controles
mostrarcontroles True
'se actualizan los textbox con la nueva información
rellenar
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End If
End Sub
Private Sub Command9_Click()
On Error Resume Next
'Siempre declarar las variables
'Una para el texto a buscar y otra para el select
Dim textoabuscar As String, sql
'La mas fácil, usamos un inputbox
textoabuscar = InputBox("Ingrese dato a buscar", "Cuadro de Busqueda de Catedráticos")
'Esto es necesario sino te enviará un error de que rel recordset esta abierto.
If rst.State = 1 Then rst.Close
'nos fijamos si el dato ingresado se corresponde con un tipo fecha
'en tal caso utilizamos la condición sql primera
If IsDate(textoabuscar) Then
sql = sql & "select * from catedraticos where fecha_de_ingreso like '" & textoabuscar & "%'"
sql = sql & "OR fecha_de_baja like '" & textoabuscar & "%'OR fecha_de_nacimiento like '" & textoabuscar & "%'"
Else
'sino es una fecha utilizamos la siguiente.
'el operador no se entera de este tipo de busqueda.
sql = sql & "select * from catedraticos where numero_empleado like '" & textoabuscar & "%'"
sql = sql & "OR status_actual like '" & textoabuscar & "%'OR nombre_completo like '" & textoabuscar & "%'"
sql = sql & "OR lugar_de_nacimiento like '" & textoabuscar & "%'OR nacionalidad like '" & textoabuscar & "%'"
sql = sql & "OR estado_civil like '" & textoabuscar & "%'OR codigo_postal like '" & textoabuscar & "%'"
sql = sql & "OR telefono_domicilio like '" & textoabuscar & "%'OR telefono_celular like '" & textoabuscar & "%'"
sql = sql & "OR correo_electronico like '" & textoabuscar & "%'"
End If
'Se realiza la busqueda
rst.Open (sql)
'Se apuntan los textbox al primer registro
rst.MoveFirst
'se actualizan los textbox
rellenar
'Si tiene alguna imagen, se muestra en el picturebox
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
' Asignar el nombre de la base de datos
' (si la aplicación se ejecuta en el directorio raiz, quitar el \)
Dim sBase
sBase = App.Path & "\base_datos_catedraticos.mdb"
' Crear los objetos
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sBase
rst.Open "SELECT * FROM catedraticos", cnn, adOpenDynamic, adLockOptimistic
rellenar
rst.MoveFirst
'carga la imagen del educando en el picturebox si existe
If rst!foto <> Empty Then
Call cargar_Imagen(Picture1, rst!foto)
Else
'caso contrario limpia el picture
Picture1.Cls
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Local Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Sub cargar_Imagen(Objeto As Object, Path_Foto As String)
On Error Resume Next
Dim Pos_x As Single
Dim Pos_y As Single
Dim Anchoimagen As Single
Dim Altoimagen As Single
Dim Anchoobjeto As Single
Dim Altoobjeto As Single
Dim escalaoriginal As Single
Set foto = LoadPicture(Path_Foto)
With Objeto
.AutoRedraw = True
.Cls
escalaoriginal = .ScaleMode
.ScaleMode = vbPixels
Anchoimagen = .ScaleX(foto.Width, vbHimetric, vbPixels)
Altoimagen = .ScaleY(foto.Height, vbHimetric, vbPixels)
Anchoobjeto = .ScaleWidth
Altoobjeto = .ScaleHeight
If Anchoimagen > Anchoobjeto Then
Anchoimagen = Anchoimagen - (Anchoimagen - Anchoobjeto)
Altoimagen = Altoobjeto
End If
If Altoimagen > Altoobjeto Then
Altoimagen = Altoimagen - (Altoimagen - Altoobjeto)
Anchoimagen = Anchoobjeto - (Anchoimagen - Anchoobjeto)
End If
Pos_x = (Anchoobjeto - Anchoimagen) / 2
Pos_y = (Altoobjeto - Altoimagen) / 2
End With
Objeto.PaintPicture foto, Pos_x, Pos_y, Anchoimagen, Altoimagen
Objeto.ScaleMode = escalaoriginal
End Sub
Sub mostrarcontroles(control As Boolean)
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
Text6.Enabled = False
Text7.Enabled = False
Text8.Enabled = False
Text9.Enabled = False
Text10.Enabled = False
Text11.Enabled = False
Text12.Enabled = False
Text13.Enabled = False
Text14.Enabled = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command9.Enabled = True
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
If control = True Then
Command5.Enabled = True
Else
Command8.Enabled = True
End If
Command6.Enabled = True
End Sub
Sub ocultarcontroles(control As Boolean)
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text5.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Text8.Enabled = True
Text9.Enabled = True
Text10.Enabled = True
Text11.Enabled = True
Text12.Enabled = True
Text13.Enabled = True
Text14.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
If control = True Then
Command5.Enabled = False
Else
Command8.Enabled = False
End If
Command6.Enabled = False
Command9.Enabled = False
End Sub
Sub rellenar()
On Error Resume Next
With rst
'Simple y efectivo, si el campo no esta vacío
If !id_catedratico <> Empty Then
Text1 = !id_catedratico
Else: Text1 = ""
End If
If !numero_empleado <> Empty Then
Text2 = !numero_empleado
Else: Text2 = ""
End If
If !status_actual <> Empty Then
Text3 = !status_actual
Else: Text3 = ""
End If
If !fecha_de_ingreso <> Empty Then
Text4 = !fecha_de_ingreso
Else: Text4 = ""
End If
If !fecha_de_baja <> Empty Then
Text5 = !fecha_de_baja
Else: Text5 = ""
End If
If !nombre_completo <> Empty Then
Text6 = !nombre_completo
Else: Text6 = ""
End If
If !fecha_de_nacimiento <> Empty Then
Text7 = !fecha_de_nacimiento
Else: Text7 = ""
End If
If !lugar_de_nacimiento <> Empty Then
Text8 = !lugar_de_nacimiento
Else: Text8 = ""
End If
If !nacionalidad <> Empty Then
Text9 = !nacionalidad
Else: Text9 = ""
End If
If !estado_civil <> Empty Then
Text10 = !estado_civil
Else: Text10 = ""
End If
If !codigo_postal <> Empty Then
Text11 = !codigo_postal
Else: Text11 = ""
End If
If !telefono_domicilio <> Empty Then
Text12 = !telefono_domicilio
Else: Text12 = ""
End If
If !telefono_celular <> Empty Then
Text13 = !telefono_celular
Else: Text13 = ""
End If
If !correo_electronico <> Empty Then
Text14 = !correo_electronico
Else: Text14 = ""
End If
End With
End Sub
Private Sub Text4_LostFocus()
Dim mensaje
mensaje = Text4.Text
'todo sucede al perder el foco el text4
'Se fija si la fecha es válida, en tal caso la asigna al textbox
'no importa donde pongas el día o el mes, verás que adopta la forma conveniente.
If IsDate(mensaje) Then
Text4.Text = Format(mensaje, "General Date")
Else
'si no es una fecha válida lo informa al operador y vacía el contenido del text4
MsgBox mensaje & " no es una fecha válida", vbCritical, "Catedrático te informa!."
Text4.Text = ""
End If
End Sub
Private Sub Text5_LostFocus()
Dim mensaje
mensaje = Text5.Text
If IsDate(mensaje) Then
Text5.Text = Format(mensaje, "General Date")
Else
MsgBox mensaje & " no es una fecha válida", vbCritical, "Catedrático te informa!."
Text5.Text = ""
End If
End Sub
Private Sub Text7_LostFocus()
Dim mensaje
mensaje = Text7.Text
If IsDate(mensaje) Then
Text7.Text = Format(mensaje, "General Date")
Else
MsgBox mensaje & " no es una fecha válida", vbCritical, "Catedrático te informa!."
Text7.Text = ""
End If
End Sub
---------------------------------------------------------------
Un abrazo y cualquier cosa a tu disposición.
Desde Bragado, Provincia de Buenos Aires, Argentina.
Luis
Ciclo if en vb 6