Ajustar el tamaño de un objeto al tamaño de una sección del formulario

Mediante el siguiente código se ajusta el tamaño de un objeto (Cuadro, en este caso) al tamaño de la sección del formulario en el que está situado. Este código no funciona en Access 2000, para éste habría que sustituir el comando .move por .left, .top, .width, y .height.

Private Sub Form_Resize()
On Error GoTo Err_Form_Resize
Dim intAlto, intAncho As Integer
intAlto = Me.InsideHeight - Me.EncabezadoDelFormulario.Height - Me.PieDelFormulario.Height - 200
intAncho = Me.InsideWidth - 200
If intAlto < 0 Or intAncho < 0 Then
Exit Sub
Else
Me.Cuadro.Move Left:=100, Top:=100, Width:=intAncho, Height:=intAlto
End If
Exit_Form_Resize:
Exit Sub
Err_Form_Resize:
MsgBox Err.Description
Resume Exit_Form_Resize
End Sub

Control de compras v.0911.1

Acabo de añadir un página en el blog desde la que se puede acceder a una pequeña aplicación creada por mí para la gestión y control de compras. Espero que os sea de utilidad.

Acceso a la página

 

Fondos transparantes con ventanas modales

El siguiente ejemplo muestra como añadir una capa transparente que cubra la pantalla, estableciendo la atención del usiario sobre un formulario u otra ventana popup. Para ello se utilizan algunas llamadas a API Win 32 para modificar la transparencia de un formulario tipo de Microsoft Access para hacer oscurecer, en este caso, la pantalla.

Este ejemplo permite elegir establecer el fondo en toda la pantalla del ordenador o sólo en la ventana principal de Access.

Mediante la propiedad LightBoxForm.LayerToFullScreen se puede indicar de qué forma se quiere mostrar la capa transparente de fondo: toda la pantalla o sólo la ventana de Access. También se puede mostrar la capa transparente usando las llamadas a LightboxForm.Show o LightboxForm.Hide.

Una ventana modal es una ventana o cuadro de diálogo que requiere que el usuario realice alguna acción antes de que el foco cambie a otro formulario o cuadro de diálogo.

Descargar: Access 2000/2002.

Fuente: blog.nkadesign.com

Comprobando variables ‘en blanco’

A menudo hay que testear si una variable no tiene contenido o está ‘vacía’. Para comprobar esto hay que tener en cuenta el tipo de datos sobre el que estamos actuando:

• Para un tipo de dato Object la variable puende se Nothing.
• Para un tipo String la cadena puede tener ningún contenido: “”, vbNullString.
• Para un Variant la candea puede teenr cualquiera de los siguientes atributos o valores:
  • Puede ser Missing is la variable es un parámetro opcional no utilizado.
  • Puede der Empty si nunca fue asiganada,
  • Puede ser Null si, por ejemplo, está asociado a una campo nulo o no continene ningún valor,
  • Puede ser una cadena vacía: “”, vbNullString.

Cuando comprobamos esas variables mediante código puede resultar pesado tener que probar todas las posibilidades hasta encontrar aquella que funcione correctamente, independientemente del tipo de variable que estemos utilizando.

Para evitar tener que hacer todas estas pruebas, haciendo la elaboración del código más pesada, uso esta pequeña función bastante a menudo:

' True si el argumento es Nothing, Null, Empty, Missing o una cadena vacía.
Public Function IsBlank(arg As Variant) As Boolean
Select Case VarType(arg)
Case vbEmpty
IsBlank = True
Case vbNull
IsBlank = True
Case vbString
IsBlank = (arg = vbNullString)
Case vbObject
IsBlank = (arg Is Nothing)
Case Else
IsBlank = IsMissing(arg)
End Select
End Function

Así no tengo que preocuparme sobre el tipo de varible que estoy testando cuando quiero saber si contiene datos válidos:

...
' Para este ejemplo se entiende que CustomerReference es un control de un formulario.
' Usando IsBlank() nosotros evitamos tener que probar la función para los valores Null y cadena vacía.
If IsBlank(CustomerReference) Then
MsgBox "Customer Reference no puede ser dejado en blanco."
End If
...

Fuente: blog.nkadesign.com

Deshabilitar el menú contextual en textbox y combos

Este ejemplo utiliza un Hook para interceptar los mensajes de Windows que llegan a nuestra aplicación, y de esta forma poder deshabilitar el menú contextual de un TextBox al hacer click derecho (el menú de copiar, pegar, seleccionar todo, …)

Para inicializar el hook se debe llamar a la función Hook y para removerlo o finalizarlo , la función UnHook.

A los dos procedimientos, se le debe pasar como parámetro el Hwnd del control Textbox.

Para deshabilitar el menú:

Call Hook (Text1.Hwnd)

Para habilitar el menú:

Call UnHook (Text1.hwnd)

Colocar un control Textbox llamado Text1 en el formulario. El Hook o procedimiento que procesa los mensajes, debe estar obligatoriamente declarado en un modulo:

'Función Api SetWindowLong
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
' Función Api CallWindowProc
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Constantes
' mensaje para el menú contextual
Public Const WM_CONTEXTMENU = &H7B
Global lpPrevWndProc As Long
'Comienza el Hook
Public Sub Hook(Handle As Long)
lpPrevWndProc = SetWindowLong(Handle, -4, AddressOf WinProc)
End Sub
'Termina el Hook
Public Sub Unhook(Handle As Long)
Call SetWindowLong(Handle, -4, lpPrevWndProc)
End Sub
'Procedimiento chequea los mensajes que llegan para ver si se despliega el menú contextual en el textbox indicado
Public Function WinProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Chequea si el mensaje  es WM_CONTEXTMENU (el menú contextual)
If Msg = WM_CONTEXTMENU Then
WinProc = True
Else
WinProc = CallWindowProc(lpPrevWndProc, hWnd, Msg, wParam, lParam)
End If
End Function

Y colocar esto en el formulario:

Option Explicit
Private Sub Form_Load()
'Inicializa el Hook ( Indicar el Textbox a deshabiltar )
Call Hook(Text1.hWnd)
End Sub
<p>Private Sub Form_Unload(Cancel As Integer)
'Remueve
Call Unhook(Text1.hWnd)
End Sub

Si quisieramos deshabilitar el menú contextual de todos los controles textbox que hay en el form, podemos hacerlo con un bucle For Each:

Option Explicit
Private Sub Form_Load()
Dim Ctrl As Control
'Recorre todos los textbox del formulario
For Each Ctrl In Me.Controls
'Verifica que el control es un textbox
If TypeOf Ctrl Is TextBox Then
'Inicia el hook
Hook Ctrl.hWnd
End If
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim Ctrl As Control
'Recorre en un bucle  todos los textbox del form
For Each Ctrl In Me.Controls
'¿ Es un textbox ?
If TypeOf Ctrl Is TextBox Then
'Finaliza el hook
Unhook Ctrl.hWnd
End If
Next
End Sub

Otra forma de poder realizar esto sin un Hook, es creando nuestro propio menú con el editor de Visual basic, y en el evento mouseDown del textbox, desplegamos un menú propio:

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbRightButton Then Exit Sub
Text1.Enabled = False
Text1.Enabled = True
Text1.SetFocus
'Despliega el PopupMenu en el textbox
Me.PopupMenu mnu_popUp
End Sub

Fuente: www.recursosvisualbasic.com.ar

Activar una combinación de teclas en un formulario

Con el código siguiente cuando presionamos las teclas Ctrl+Alt+A muestra un mensaje. La clave es tener la propiedad KeyPreview del formulario en True, para poder así interceptar cualquier evento de presión de tecla, y también verificar el parámetro KeyCode del evento KeyDown del formulario.

Option Explicit
'Variable booleanas para determinar si está presionadas las teclas
Dim Ctrl As Boolean, Alt As Boolean, A As Boolean

'Constantes de las teclas Alt, Ctrl y a
Private Const vbKeyA = 65
Private Const vbKeyalt = 17
Private Const vbKeyControl = 18

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'Verifica las teclas Alt - Ctrl y la A
If KeyCode = vbKeyalt Then Ctrl = True
If KeyCode = vbKeyControl Then Alt = True
If KeyCode = vbKeyA Then A = True
'Si las 3 variables están en True .. mostramos un mensaje
If Ctrl And Alt And A Then
MsgBox "Hola"
Form_KeyUp 0, 0
End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'Cuando se produce KeyUp ponemos las variables en false
Ctrl = False
Alt = False
A = False
End Sub

Private Sub Form_Load()
'Establecemos la propiedad KeyPreview para que el formulario intercepte cualquier intento de presión de tecla
Me.KeyPreview = True
Me.Caption = " Ejemplo de  combinación de teclas "
MsgBox " Presiona las teclas Ctrl+Alt+a", vbInformation
End Sub

Para poder crear una combinación de teclas también se puede utilizar la función del api RegisterHotKey.

Fuente: www.recursosvisualbasic.com.ar

Introducir un valor en formato ‘porcentaje’

La siguiente función añade el símbolo ‘%’ a un número para para darle el formato de ‘porcentaje’. Así lo primero que realiza es comprobar que el valor que se le pasa no es nulo, y que no contiene el símbolo ‘%’. Tras esto divide el número entre 100 y le añade ‘%’. Para aplicarla a un cuadro de texto no hay más que incorporarla en el evento After Update de la siguiente forma “=MakePercent([TextBox])“

Public Function MakePercent(txt As TextBox)
On Error GoTo Err_Handler
If Not IsNull(txt) Then
If InStr(txt.Text, "%") = 0 Then
txt = txt / 100
End If
End If
Exit_Handler:
Exit Function
Err_Handler:
If Err.Number <> 2185 Then 'No Text property unless control has focus.
MsgBox "Error " & Err.Number & " - " & Err.Description
End If
Resume Exit_Handler
End Function

Fuente: www.everythingaccess.com

Desconectar la rueda del ratón

El siguiente ejemplo muestra como ‘anular’ temporalmente la rueda de deslizamiento del ratón, para impedir de esta forma que en un formulario, en el que sólo se quiera mostar un registro, se puedan recorrer todos.

Descargar: Access 2000.

Fuente: www.everythingaccess.com

Eliminar una tabla de la base de datos

La siguiente función muestra como eliminar una tabla (‘AYUDANTES’) de una base de datos (‘c:\data\local.mdb‘)

Function BorraTabla()
Dim DataBaseName, TableName As String
Dim DB As Database, t As TableDef
Dim TableExists As Boolean
DataBaseName = "c:\data\local.mdb"
TableName = "AYUDANTES"
On Error GoTo errorhandler
Set DB = Workspaces(0).OpenDatabase(DataBaseName)
On Error Resume Next
Set t = DB.TableDefs(TableName)
TableExists = Err.Number = 0
If TableExists Then
DB.Execute "Drop Table " & TableName
End If
DB.Close
Exit Function
errorhandler:
Err.Raise Err.Number
Exit Function
End Function

Fuente: davidsuarez.es

Importar objetos de una base de datos

El siguiente código permite importar todos los elementos existentes en un archivo de access: tablas, formularios, informes, módulo, …

Function ImportAllObject(strDataBase As String)
Dim Dbs As Database
Dim tdf As TableDef
Dim qry As QueryDef
Dim cnt As Container
Dim doc As Document
Set Dbs = OpenDatabase(strDataBase)
'Importa las tablas
For Each tdf In Dbs.TableDefs
If Left(tdf.Name, 4) <> "msys" Then
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strDataBase, acTable, tdf.Name, tdf.Name, False, True
End If
Next
'Importa las consultas
For Each qry In Dbs.QueryDefs
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strDataBase, acQuery, qry.Name, qry.Name, False, True
Next
'Importa los formularios
Set cnt = Dbs.Containers("Forms")
For Each doc In cnt.Documents
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strDataBase, acForm, doc.Name, doc.Name, False, True
Next
'Importa los informes
Set cnt = Dbs.Containers("Reports")
For Each doc In cnt.Documents
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strDataBase, acReport, doc.Name, doc.Name, False, True
Next
'Importa las macros
Set cnt = Dbs.Containers("Scripts")
For Each doc In cnt.Documents
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strDataBase, acMacro, doc.Name, doc.Name, False, True
Next
'Importa los módulos
Set cnt = Dbs.Containers("Modules")
For Each doc In cnt.Documents
DoCmd.TransferDatabase acImport, "Microsoft Access", _
strDataBase, acModule, doc.Name, doc.Name, False, True
Next
Dbs.Close: Set Dbs = Nothing
Set cnt = Nothing
End Function

Fuente: access.jessy.free.fr