Extracto de cdigo Visual Basic para Ms Access

Estudiar el bloqueo de registros y los informes del Hogar Botones con texto e imagen Para que en los botones aparezca imagen e icono, pones un botn con texto y una imagen al lado, sobrepuesta, capturas pantalla y guardas el recorte del texto y la imagen como .bmp. Despus, al crear el botn slo has de decirle que lo quieres como imagen y se la pones. No se nota nada de nada. Access en red Se programa todo junto, luego divides la base de datos, en el servidor pones la que tiene las tablas, y en los terminales pones las otras con tablas vinculadas. Comando Aceptar En primer lugar controla que determinados campos no estn en blanco, si ambos estn completos simplemente cierra el formulario activo. Se supone que los datos nuevos y/o modificados quedan guardados con esta operacin.
Private Sub Comando_Click() On Error GoTo Err_Comando_Click If IsNull(Nombre) = True Then mensaje = MsgBox("Has de completar el nombre del socio", vbExclamation, "Datos incompletos") ElseIf IsNull(Fechana) = True Then mensaje = MsgBox("Has de completar la fecha de nacimiento", vbExclamation, "Datos incompletos") Else DoCmd.Close [Forms]![Principal]![Subformulario].[Form].Requery 'Actualiza Principal End If Exit_Comando_Click: Exit Sub Err_Comando_Click: MsgBox Err.Description Resume Exit_Comando_Click End Sub

Comando Cancelar Antes de cerrar el formulario deshace los cambios realizados. Para evitar que el programa falle si no se han hecho cambios, programamos en el fallo la salida del formulario.
Private Sub Comando_Click() On Error GoTo Err_Comando_Click DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70 DoCmd.Close Exit_Comando_Click: Exit Sub Err_Comando_Click: DoCmd.Close Resume Exit_Comando_Click End Sub

Comando edita Abre el formulario denominado edita y presenta el mismo socio que est seleccionado en el formulario consulta. Seguidamente, cambia el valor de la variable y cerramos el formulario anterior.
Private Sub Comando_Click() On Error GoTo Err_Comando_click Dim stDocName As String Dim stLinkCriteria As String stDocName = "Edita" stLinkCriteria = "[Idsoc]=" & Me![Idsoc]

Pg. 1 de 6

Extracto de cdigo Visual Basic para Ms Access

DoCmd.OpenForm stDocName, , , stLinkCriteria stDocName = "consulta" DoCmd.Close acForm, stDocName Exit_Comando_click: Exit Sub Err_Comando_click: MsgBox Err.Description Resume Exit_Comando_click: End Sub

Evento abrir del formulario consulta En este evento, que viene de la consulta, controlamos que el nmero de socio no est en blanco, si lo est es que el nmero introducido como parmetro en la consulta no existe en nuestra tabla, as que sacamos un mensaje de error diciendo que no existe
Private Sub Form_Open(Cancel As Integer) If IsNull(Idsoc) Then DoCmd.Close mensaje = MsgBox("No existe socio con ese nmero", vbExclamation, "Error") End If End Sub

Cambiar estado del registro Sirve para dar de baja registros sin borrarlos de la tabla y, por tanto manteniendo los datos. Una idea es pasarlos a otra tabla Histrico que no entorpezca el funcionamiento normal. En este caso ha habido que refrescar el formulario despus de cambiar la fecha porque no lo haca automticamente. Observar que el usuario ha de confirmar el cambio de estado.
Private Sub Comando_Click() On Error GoTo Err_Comando106_Click mensaje = MsgBox("Desea dar de baja el socio?", vbYesNo, "Confirmacin baja") If mensaje = vbYes Then Fechabaja = [Texto] [Forms]![edita].[Form].Requery End If Exit_Comando_Click: Exit Sub Err_Comando_Click: DoCmd.Close Resume Exit_Comando_Click End Sub

Comprobar registros repetidos Para evitar la introduccin de registros iguales, controlamos en el evento Despus de actualizar que busque en toda la tabla un registro con un campo igual. Existen dos posibilidades: que el campo sea texto (string)
Private Sub NIF_AfterUpdate() Dim existe As Variant existe = DLookup("Nif", "Tabla", "Nif = '" & Me.NIF & "'") If IsNull(existe) = False Then mensaje = MsgBox("Este socio ya existe en la base de datos", vbInformation, "Datos duplicados") End If End Sub

Y dos, que el campo sea numrico

Dim existe As Variant existe = DLookup("Id_asiento", "Asientos", "[Id asiento]=" & Me.Id_asiento) If IsNull(existe) = False Then

Pg. 2 de 6

Extracto de cdigo Visual Basic para Ms Access

mensaje = MsgBox("Este asiento ya existe", vbInformation, "Datos duplicados") [Id asiento] = "" [Id asiento].SetFocus End If

Aadir nuevo registro Codificado a la carga del formulario, va enlazado con una consulta (maxsoc) que contiene el nmero mximo de socio, slo falta aadir un nuevo registro y sumarle 1 a esta cantidad.
Private Sub Form_Open(Cancel As Integer) Dim num As Integer DoCmd.GoToRecord , , acNewRec Dim basedatos As Database Dim registros As Recordset Set basedatos = CurrentDb 'asigna a basedatos la actual Set registros = basedatos.OpenRecordset("maxsoc", dbOpenDynaset) num = registros!maximo + 1 DoCmd.GoToRecord , , acNewRec [Idsoc] = num [Fechaalta] = Texto65 End Sub

Ejecutar consulta de borrado Desupus de llamar a la consulta Borra hacemos un refresco del subformulario para que se actualizen los datos. Tambin aplicable este refresqueo despus de aadir o modificar. Apunte interesante el de estudiar el borrado de registro mediante cdigo.
Private Sub Comando_Click() Dim stDocName As String Dim stLinkCriteria As String stDocName = "Borra" DoCmd.OpenQuery stDocName, acNormal, acEdit [Forms]![Principal]![Subformulario].[Form].Requery End Sub

Eliminar registro seleccionado de una tabla sin confirmaciones de access

Dim mensaje As String mensaje = MsgBox("Desea eliminar la lnea", vbYesNo, "Eliminacin") If mensaje = 6 Then Dim var As String var = "DELETE * FROM lineas WHERE lineas.idlin = " & Val(Me.linea.Value) DoCmd.SetWarnings False 'se apagan los mensajes por default del access DoCmd.RunSQL var 'sen ejecuta la consulta de eliminacin DoCmd.SetWarnings True 'se encienden los mensajes por default de access [Forms]![A_cabecera]![Subformulario].[Form].Requery End If

Apertura de formularios La apertura de los formularios se realiza siempre igual, aqu interesante el control del error, generalmente provocado por la pulsacin de la tecla Cancelar de la pantalla que pide el parmetro.
Private Sub Comando_Click() On Error GoTo Err_Comando_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "Consulta" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_Comando_Click:

Pg. 3 de 6

Extracto de cdigo Visual Basic para Ms Access

Exit Sub Err_Comando_Click: mensaje = MsgBox("Operacin cancelada", vbInformation, "Consulta") Resume Exit_Comando_Click End Sub

Otra de tratamiento de errores Es un caso similar al de la apertura de formularios, aqu es la pantalla de bsquedas la que provoca el error si el foco no est bien situado.
Private Sub Comando_Click() On Error GoTo Err_Comando30_Click Screen.PreviousControl.SetFocus DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70 Exit_Comando30_Click: Exit Sub Err_Comando_Click: mensaje = MsgBox("Selecciona un campo para bsquedas", vbExclamation, "Error") Resume Exit_Comando_Click End Sub

Botones de opcin que cambian de subformulario Cdigo muy prctico a la hora de aplicar filtros en los subformularios, si no funcionan bien, como ha sido el caso, se hacen dos consultas y se programa el cambio de formulario, adems del cambio de seleccin de botn. No queda muy elegante, as que se aconseja la utilizacin de filtros y quedar esta opcin en ltimo lugar.
Private Sub Opcin18_Click() On Error GoTo Err_Opcin18_Click Opcin20 = 0 Subformulario.SourceObject = "Subformulario" Exit_Err_Opcin18_Click: Exit Sub Err_Opcin18_Click: MsgBox Err.Description Resume Exit_Err_Opcin18_Click End Sub

Filtros Ejemplo del uso de filtros. Este en particular no funcionaba bien cuando se cambiaba el orden del subformulario, pero puede servir para otro caso.
Dim filtro As String filtro = "Subformulario.Fechabaja Is Null" Me.Controls("Subformulario").Form.Filter = filtro Me.Controls("Subformulario").Form.FilterOn = True

Abrir un registro ya seleccionado en subformulario Al hacer doble clic en la lnea del subformulario en modo tabla se abre el formulario Consulta con los datos del socio que habamos seleccionado.
Private Sub Idsoc_DblClick(Cancel As Integer) Dim stDocName As String Dim stLinkCriteria As String stDocName = "Consulta" stLinkCriteria = "[Idsoc]=" & Me![Idsoc] DoCmd.OpenForm stDocName, , , stLinkCriteria End Sub

Registros simultneos en formulario y subformulario Programado en el evento Al Activar registro, hace que en el formulario principal se muestren t odos los datos del registro seleccionado en el subformulario.

Pg. 4 de 6

Extracto de cdigo Visual Basic para Ms Access

Private Sub Form_Current() On Error GoTo fallo Dim num As Integer Dim filtro As String num = Me![Idsoc] filtro = "Idsoc=" & num [Forms]![Principal].Filter = filtro [Forms]![Principal].FilterOn = True salida: Exit Sub fallo: MsgBox Err.Description Resume salida End Sub

Funcin para calcular la edad Esta function hay que ponerla en un mdulo. Despus la llamas desde donde quieras, le pasas los parmetros de fecha de nacimiento y fecha actual en formato fecha y te devuelve la edad. En el caso que nos ocupa la llamada se hace desde campos calculados en diversas consultas de la siguiente forma:
Edad: Edad([Fechana];Ahora()) Function Edad(fechaBase As Variant, fechaRef As Variant) As Integer On Error GoTo errores Edad = DateDiff("yyyy", fechaBase, fechaRef) If Month(fechaBase) > Month(fechaRef) Then Edad = Edad - 1 If Month(fechaBase) = Month(fechaRef) Then If Day(fechaBase) > Day(fechaRef) Then Edad = Edad - 1 End If End If Exit Function errores: Edad = 0 End Function

Registro que no existe Muy til a la hora de controlar los errores al abrir consultas con registros que no existen. Slo controla que salga en blanco el campo principal en el evento abrir.
Private Sub Form_Open(Cancel As Integer) If IsNull(Idsoc) Then DoCmd.Close mensaje = MsgBox("No existe socio con ese nmero", vbExclamation, "Error") End If End Sub

Macro AUTOEXEC Crear macro llamada AUTOEXEC, que va a ser la primera cosa que haga el programa al abrir. La idea es darle una orden de minimizar, con lo cual se minimiza la ventana de la base de datos, otra orden de abrir el formulario principal y una tercera de maximizar. Al editar se queda en la pgina de ficha seleccionada Cuando le das al botn editar para que se quede en la ficha que estamos trabajando.
Dim ControlFicha As Control, Pagina As Page ' Devuelve referencia al control de ficha. Set ControlFicha = Me!TabCtl97 ' Devuelve referencia a la pgina seleccionada actualmente. Set Pagina = ControlFicha.Pages(ControlFicha.Value) Pagina.SetFocus

Cerrar formulario con tecla esc

Crea un boton de comando, que cierre el formulario, o la consulta. En las opciones de dicho botn, hay una opcion que pone cancelar, que por defecto est a No. Ponla a Si y listo.

Pg. 5 de 6

Extracto de cdigo Visual Basic para Ms Access

Imprimir con opciones
DoCmd.RunCommand acCmdPrint

Pg. 6 de 6