Argumentos

Argumento	Descripción
Seis primeros argumentos	Exactamente igual que los que aparecen en la ayuda de VBA para Access sobre la función InputBox
Style	Opcional. Este argumento es el que afecta al estilo que adoptará el InputBox. Ves a la sección Valores para consultar los valores posibles y una descripción de cada uno de los estilos
MaxChar	Opcional. Si este argumento tiene valor, indicará el límite máximo de caracteres que el InputBoxEx admitirá.

Valores

Valor	Descripción
SNone	Muestra un InputBox normal
Spassword	Muestra un InputBox con caracteres tipo asterisco
Snumber	Muestra un InputBox que sólo aceptará número (sin decimales)
SLowerCase	El InputBox mostrará todos los caracteres introducidos en mayúsculas
SUpperCase	El InputBox mostrará todos los caracteres introducidos en minúsculas

Contraseña = InputBoxEx("Introduzca su contraseña", _
                                      "Control de usuarios", , , , , , SPassword)

'---------------------------------------------------------
'
' InputBoxEx
'
' Código escrito originalmente por Juan M Afán de Ribera.
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
'     accessvbafaq@ya.com
'
' Este código se brinda por cortesía de
' Juan M. Afán de Ribera
'
'
' estilos del InputBoxEx
Public Enum StyleInputBox
    SNone       ' InputBox normal
    SPassword   ' máscara oculta
    SNumber     ' sólo números
    SLowerCase  ' sólo minúsculas
    SUpperCase  ' sólo mayúsculas
End Enum

Private Declare Function FindWindowEx Lib "user32" _
                Alias "FindWindowExA" _
                (ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
                
Private Declare Function SendMessage Lib "user32" _
                Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
                (ByVal hwnd As Long, _
                ByVal nIndex As Long) As Long
                
Private Declare Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
                (ByVal hwnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long
                
Private Declare Function SetTimer Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nIDEvent As Long, _
                ByVal uElapse As Long, _
                ByVal lpTimerFunc As Long) As Long
                
Private Declare Function KillTimer Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nIDEvent As Long) As Long

Private Const GWL_STYLE = (-16)

' constantes con los estilos de
' controles 'EDIT'
Private Const ES_UPPERCASE = &H8
Private Const ES_LOWERCASE = &H10
Private Const ES_PASSWORD = &H20
Private Const ES_NUMBER = &H2000

' mensaje para establecer el caracter que se mostrará
' como máscara para el InputBoxEx tipo contraseña
Private Const EM_SETPASSWORDCHAR = &HCC
' constante que contiene el carácter que se mostrará
' (este valor puede ser cualquier otro, en este caso
' he escogido el típico asterisco)
Private Const KEY_MASK = 42& ' "*"
' mensaje para establecer el número máximo de
' caracteres permitidos
Private Const EM_LIMITTEXT = &HC5

Private SInputBox As StyleInputBox
Private hInputBox As Long
Private cChar As Long
Private Tm As Long

Public Function InputBoxEx( _
                Prompt, _
                Optional Title, _
                Optional Default, _
                Optional XPos, _
                Optional YPos, _
                Optional HelpFile, _
                Optional Context, _
                Optional Style As StyleInputBox = SNone, _
                Optional MaxChar As Long) As String
              
    ' si no hay ningún otro InputBoxEx abierto...
    If hInputBox = 0 Then
       ' Creamos un timer que se ejecutará a la décima de segundo
       Tm = SetTimer(0&, 0&, 100, AddressOf TimerProc)
    
       SInputBox = Style
       cChar = MaxChar
       ' llamamos al InputBox de manera normal
       On Error GoTo AnularTimer
       InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    End If
    
    Exit Function
    
AnularTimer:
    ' si ha habido algún error, se cancela la operación
    Call KillTimer(0&, Tm)
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    
End Function

Private Sub TimerProc( _
                     ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal idEvent As Long, _
                     ByVal dwTime As Long)
Dim hEdit As Long
Dim CurStyle As Long
    
    ' localizamos el manipulador de la ventana activa
    ' (se supone que es la ventana del InputBox)
    hInputBox = GetForegroundWindow
    ' localizamos el manipulador de la caja de texto
    ' del InputBox
    hEdit = FindWindowEx(hInputBox, 0&, "EDIT", vbNullString)
    
    ' obtenemos los estilos de la caja de texto ...
    CurStyle = GetWindowLong(hEdit, GWL_STYLE)
    
    Select Case SInputBox
        Case SPassword ' tipo password
            ' le decimos a la caja de texto cuál será el carácter
            ' que aparecerá en vez de lo que teclee el usuario
            Call SendMessage(hEdit, EM_SETPASSWORDCHAR, KEY_MASK, 0&)
            ' y le añadimos el estilo de introducción de contraseñas
            CurStyle = CurStyle Or ES_PASSWORD
        Case SNumber ' tipo número
            CurStyle = CurStyle Or ES_NUMBER
        Case SLowerCase ' tipo minúsculas
            CurStyle = CurStyle Or ES_LOWERCASE
        Case SUpperCase ' tipo mayúsculas
            CurStyle = CurStyle Or ES_UPPERCASE
    End Select
    
    If cChar > 0 Then
        Call SendMessage(hEdit, EM_LIMITTEXT, cChar, 0&)
    End If
    ' cambiamos el estilo
    Call SetWindowLong(hEdit, GWL_STYLE, CurStyle)
    ' desactivamos el timer para que sólo se ejecute esta vez
    Call KillTimer(0&, Tm)
    hInputBox = 0
    
End Sub
'---------------------------------------------------------

Ejemplos:

InputBoxEx. Access 2000 o superior

InputBoxEx97 Access 97

Temas relacionados:

MsgBoxEx (nuevo - compatible con VB)