** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Limitar longitud en InputBox.
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoLimitar longitud en InputBox.

 Responder Responder
Autor
Mensaje
fredy8alc Ver desplegable
Asiduo
Asiduo


Unido: 19/Abril/2016
Localización: España
Estado: Sin conexión
Puntos: 239
Enlace directo a este mensaje Tema: Limitar longitud en InputBox.
    Enviado: 30/Marzo/2020 a las 20:08
Buenas tardes:

Quisiera plantear otra consulta más en este foro.

Se trata de limitar el número de caracteres que se pueden introducir en un inputbox.
Ahora lo tengo así:

Dim Entrada As String
do
Entrada = Inputbox("Introduce el dato (máximo 25 caracteres): ")
If Len(Entrada) > 25 Then MsgBox "El dato introducido supera la longitud máxima permitida."
Loop While Len(Entrada) > 25

Pero así, yo puedo meter en el InputBox todos los caracteres que quiera y al validar, el programa me avisa que he metido más de 25 caracteres y me devuelve a la entrada.

Yo lo que quisiera es que, directamene no me permitiese meter más de los 25 caracteres, es decir que cuando haya metido 25 caracteres no me deje metar más.
Incluso me gustaria que apareciese en el texto del InputBox como una cuenta atrás de los caracteres que me quedan por meter. Pero eso supongo que será mas complicado.

¿Se puede hacer esto en un InputBox?

Saludos, salud y gracias.
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14720
Enlace directo a este mensaje Enviado: 30/Marzo/2020 a las 20:18
Hola,

Respuesta: Hasta dónde yo se, no

Tendrás que crearte un formulario que imite esa comportamiento.

Un saludo


Xavi, un minyó de Terrassa

Mi web
Arriba
RRoca Ver desplegable
Colaborador
Colaborador


Unido: 02/Enero/2006
Localización: España
Estado: Sin conexión
Puntos: 4834
Enlace directo a este mensaje Enviado: 30/Marzo/2020 a las 21:28
Hola, en la web de Juan M. Afan de Ribera hay un ejemplo que creo te servirá.

' Ejemplo: (muestra un InputBox para introducir contrase?as, con el l?mite de
'           10 caracteres)
'
'  Contrase?a = InputBoxEx("Mensaje", "Titulo", , , , , , SPassword, 10)'
' Autor: Juan M. Afan de Ribera
'        Abril 2004

Saludos.

Romain Rolland (1866-1944) escritor y ensayista frances dijo: Crear, es matar la muerte. (para mi, filosoficamente penetrante)
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14720
Enlace directo a este mensaje Enviado: 30/Marzo/2020 a las 22:37
Hola,

¿Tienes ese ejemplo? Yo lo estoy buscando y no lo encuentro. La Web de Happy está semi-vacía y no puedo acceder (si es que está) al ejemplo.

Si lo tienes, ¿me lo puedes pasar por mail?

Un saludo

Xavi, un minyó de Terrassa

Mi web
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Enlace directo a este mensaje Enviado: 30/Marzo/2020 a las 22:59
Ahi va Xavi ...........


Option Explicit

'******************************************************
'
' InputBoxEx
'
' Función que amplía el InputBox de VBA, confiriéndole
' diferentes estilos (contenidos en la enumeración
' StyleInputBox). También, en su último argumento (MaxChar)
' podemos limitar el número de caracteres que se podrán
' introducir.
'
' Uso:
'
'   Function InputBoxEx( _
'            Prompt, _      véase en la ayuda InputBox
'            [Title], _             "       "
'            [Default], _           "       "
'            [XPos], _              "       "
'            [YPos], _              "       "
'            [HelpFile], _          "       "
'            [Context] _            "       "
'            [Style] _ ------> cualquiera de los valores de la enumeración StyleInputBox
'            [MaxChar])------> si su valor es diferente de 0 marca el límite de
'                              caracteres admitidos por el InputBox
'
' Ejemplo: (muestra un InputBox para introducir contraseñas, con el límite de
'           10 caracteres)
'
'  Contraseña = InputBoxEx("Mensaje", "Titulo", , , , , , SPassword, 10)'
' Autor: Juan M. Afan de Ribera
'        Abril 2004
'
' Saludos :-)
' happy
'*********************************************************************

' 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

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
       Call SetTimer(Access.hWndAccessApp, 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(Access.hWndAccessApp, 0&)
    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(Access.hWndAccessApp, 0&)
    hInputBox = 0
   
End Sub



Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14720
Enlace directo a este mensaje Enviado: 30/Marzo/2020 a las 23:14
Pues ahí lo tienes, si que se podía. La edad no perdona...

Javier, muchas gracias!!


Xavi, un minyó de Terrassa

Mi web
Arriba
RRoca Ver desplegable
Colaborador
Colaborador


Unido: 02/Enero/2006
Localización: España
Estado: Sin conexión
Puntos: 4834
Enlace directo a este mensaje Enviado: 31/Marzo/2020 a las 12:16
Buenos días, dado que ya te lo ha pasado Javier, solo un saludo Xavi.
Romain Rolland (1866-1944) escritor y ensayista frances dijo: Crear, es matar la muerte. (para mi, filosoficamente penetrante)
Arriba
fredy8alc Ver desplegable
Asiduo
Asiduo


Unido: 19/Abril/2016
Localización: España
Estado: Sin conexión
Puntos: 239
Enlace directo a este mensaje Enviado: 07/Abril/2020 a las 18:06
Muchas gracias a todos.
Muy útil la respuesta.
Podemos cerrar hilo.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable