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

Señalar campos obligatorios

El siguiente ejemplo muestra cómo identificar automáticamente los campos que obligatoriamente hay que completar, y el campo activo. Al contrario en otros de mis post (Campos obligatorios), aquí se conoce desde el principio los campos que son obligatorios, y no los recuerda sólo al validar los datos.

Esta forma de actuar sólo es válida para cuadros de texto, combos y listas. No es válido para formularios continuos. Y no funcionará si tiene asignado código en los eventos On Got Focus o On Lost Focus properties.

Descargar. Access 2000

Fuente: Allen Browne

Utilizar caracteres comodín en consultas

Los caracteres comodín se utilizan como sustitutos de otros caracteres cuando se especifica un valor que se desea buscar y sólo se conoce parte del valor o se buscan valores que empiezan con una cierta letra o que coinciden con un modelo.

Los caracteres comodín están concebidos para ser utilizados con campos que tienen tipo de datos texto, aunque a veces pueden ser usados también con otros tipos de datos, como fechas.

Carácter	Descripción	Ejemplo
*	Hace coincidir cualquier número de caracteres. Puede ser utilizado como el primero o el último carácter de la cadena de caracteres.	qu* encuentra quién, quiero y quieto
?	Hace coincidir cualquier carácter alfabético individual.	B?l encuentra bala, billete y bola
[ ]	Hace coincidir cualquier carácter individual situado entre los corchetes.	B[ao]l encuentra bala y bola pero no billete
!	Hace coincidir cualquier carácter que no se encuentre entre los corchetes.	r[!oc]a encuentra risa y runa pero no roca ni rosa
-	Hace coincidir cualquier carácter de un intervalo de caracteres. Debe especificar el intervalo en orden ascendente (A a Z, no Z a A).	b[a-c]d encuentra bad, bbd y bcd
#	Hace coincidir cualquier carácter numérico individual.	1#3 encuentra 103, 113 y 123

Fuente: Microsoft Office

Comprobar el NIF/CIF

Como continuación de mi post  Validar el NIF/CIF, y ante los comentarios que han surgido respecto a él he realizado una ejemplo con la utilización del código del post.

Access 2000. Descargar.

Funciones para comprobar caracteres en cadenas

Las siguientes funciones son para comprobar las cadenas de texto o numéricas.

La siguiente función devuelve “True” si todos los caracteres de una cadena son alfabéticos, es decir, si son todos letras. Si no lo son o si la cadena de texto es de longitud 0 devuelve “False”.

Public Function IsAlphaBetical(TestString As String) As Boolean
Dim sTemp As String
Dim iLen As Integer
Dim iCtr As Integer
Dim sChar As String
sTemp = TestString
iLen = Len(sTemp)
If iLen> 0 Then
For iCtr = 1 To iLen
sChar = Mid(sTemp, iCtr, 1)
If Not sChar Like "[A-Za-z]" Then Exit Function
Next
IsAlphaBetical = True
End If
End Function

Esta otra función devuelve “True” si todos los caracteres de una cadena son alfanumericos, es decir, si los elementos que componen la cadena son números o letras. Si no lo son o si la cadena de texto es de longitud 0 devuelve “False”.

Public Function IsAlphaNumeric(TestString As String) As Boolean
Dim sTemp As String
Dim iLen As Integer
Dim iCtr As Integer
Dim sChar As String
sTemp = TestString
iLen = Len(sTemp)
If iLen> 0 Then
For iCtr = 1 To iLen
sChar = Mid(sTemp, iCtr, 1)
If Not sChar Like "[0-9A-Za-z]" Then Exit Function
Next
IsAlphaNumeric = True
End If
End Function

Y por último esta función devuelve “True” si todos los caracteres de una cadena son numéricos, es decir, si los elementos que componen la cadena son números. Si no lo son o si la cadena de texto es de longitud 0 devuelve “False”. Esta función se diferencia de IsNumeric() en que Isnumeric(30.45) devuelve “True” mientras que en esta función devolvería “False”.

Public Function IsNumericOnly(TestString As String) As Boolean
Dim sTemp As String
Dim iLen As Integer
Dim iCtr As Integer
Dim sChar As String
sTemp = TestString
iLen = Len(sTemp)
If iLen> 0 Then
For iCtr = 1 To iLen
sChar = Mid(sTemp, iCtr, 1)
If Not sChar Like "[0-9]" Then Exit Function
Next
IsNumericOnly = True
End If
End Function

Fuente: David Suárez