Mascara de fecha en TextBox - Propuesta

hola a todos,

este mensaje es una especie de prueba de una idea surgida hace un par de dias en otro hilo (foro de propuestas) del
foro.

Se trataria de exponer soluciones a determinados casos (de excel/excel-vba) pero no (solo) con la idea de que le sean
utiles a alguien, ni tampoco como consultas normales (aunque en el fondo lo sean), sino para que si alguien ve [o cree
ver] cualquier cosa/parte mejorable, o conoce otra forma de hacer lo mismo de una forma mejor o mas sencilla (o
simplemente diferente), o intuye la posibilidad de errores no controlados en el original, o , en fin, cualquier cosa
que pueda servir para pulir, mejorar e incluso desechar, la propuesta se anime y lo comente.

Todo ello teniendo en cuenta que el OP (que en este caso podria cambiarse a Proponedor Original), es decir el que envia
la propuesta original, deberia asumir que corre el riesgo de que su propuesta sea criticada, corregida, modificada o
'vilipendiada', y si esto ocurre, en lugar de sentirse molesto/ofendido, intentar sacar conclusiones para
mejorar/cambiar o lo que sea, la idea inicial. Al fin y al cabo este seria el sentido de las propuestas.

Tambien el que entre a comentar/criticar/aportar algo sobre la propuesta, seria de esperar que lo haga, aparte de por
supuesto con respeto tanto para la propuesta como para el proponente (sea del nivel que sea esta y le parezca lo que le
parezca), con la idea de aportar algo, o en su defecto de evitar algun posible problema que vea pudiera surgir.

bueno, despues de las obviedades de turno, un poco comentar como creo que se podria hacer (totalmente abierto a
cualquier tipo de modificaciones):

.- en el asunto del mensaje creo que deberia ir de la forma mas clara y simple posible el cometido de la propuesta, es
decir el problema que en teoria aborda. Evitando extras como "Por si a alguien le sirve", o "Atencion. " o cualquier
otra muletilla que si se quiere se puede incluir en el cuerpo del mensaje,, pero dejando el asunto limpio para facilitar
posteriores busquedas.

.- se podria incluir tambien en el asunto algo que indicara que se trata de una propuesta, aunque tambien para facilitar
las posteriores busquedas por posibles consultantes, quizas deberia ir al final del asunto. En este caso he optado por
poner el mismo termino de "Propuesta" tras un guion al final del asunto. Habia pensado en OT pero creo que realmente no
serian Off Topic, pues seguramente su tema abordaria cuestiones tratadas a menudo en el foro

.- en el cuerpo del mensaje {creo que} deberian ir al menos una descripcion del problema/caso para el que esta hecha la
propuesta, y la propia propuesta comentada al menos en sus pasos menos evidentes de la forma mas clara posible. Tampoco
sobraria alguna idea para probar la propuesta de una manera facil.

.-tambien podrian incluirse las carencias y posibles excepciones que el proponente crea que pueden existir. Y/o las
mejoras que cree se podrian añadir.

bueno, posiblemente con poner un mensaje normal el resultado fuera el mismo, asi que si esto os parece una tonteria
tambien podeis decirlo

un saludo
Ivan

...Propuesta Mascara de fecha para textbox
...

una pregunta muy frecuente en el foro es como conseguir que al introducir una fecha en un textbox de un formulario de
VBA nos valla poniendo automaticamente los separadores, ademas de validar si lo introducido es correcto. A raiz de una
de estas consultas de hace algun tiempo nacio esta propuesta, que con algunas modificacione y con una 2ª version, y
algun extra expongo ahora.

En la propuesta hay:

1ª) dos procedimientos Sub que son las autenticas mascaras (Mascara_Fecha_1 y Mascara_Fecha_2). Se diferencian en que
con la 1ª hay que escribir los dias y meses con 2 cifras, es decir para poner el dia 1 habria que escribir '01' e
igualmente para el mes. Sin embargo en la 2ª admite un solo digito. De hecho iba a enviar solo esta 2ª que me parece mas
practica, pero los comentarios (validos en su mayoria para ambas) estaban en la 1ª pues la otra es de hace un par de
dias. Y por vagueria de cambiarlos pues envio los dos.

2ª) 2 procedimientos Function de los cuales uno (Borrando) es imprescindible y el otro casi (Mascar_De_Salida) si
queremos que el textbox se complete con la fecha correcta si salimos antes de escribirla completamente

3º) un ej. de uso en formulario para probarlos

A tener en cuenta: fundamentalmente que esta hecho exclusivamente para la configuracion regional "dd mm aa"

Mejoras posibles ( ademas de lo que podais ver cualquiera) que se me ocurren, pero que o no he encarado o no he visto
por donde tirar:

1ª) precisamente conseguir que fuera utilizable en cualquier configuracion regional

2ª) evitar el uso de mas de un procedimiento y sobre todo de KeyDow y condensarlo todo en un solo evento

bueno y aqui van los codigos. Parecen muy largos, pero en algun caso es por los comentarios y en relidad son bastante
simples. Aparte el uso del select case hace que la parte utilizada de los mismo sea minima.

Quedo a la espera de cualquier sugerencia (y aunque este mensaje no tenga respuesta, si alguien mas se anima a mandar
alguna propuesta y quiere pues que lo haga, que lo mismo el suyo si despierta mayor interes)

'************************** en un modulo normal ********************************
'
' Proyecto : VBAProj_Mascara_Fecha_TextBox
' Módulo : mod_Publicos
' Fecha : 02/10/07 16:18
' Autor : Ivan
' Proposito : formatear las entradas de fechas en un textbox segun un patron 'dd mm yy'
'
'
Option Explicit
'

Public Const Separador As String = "/" ' para elegir separador
'
'-
' .-Esta funcion nos devuelve verdadero si se ha pulsado la tecla retroceso
' y ademas el cursor esta justo detras del separador. Es dificil de explicar,
' pero en definitiva es para que si al pulsar la tecla retroceso estamos justo
' detras de uno de los separadores, no solo borre este sino tambien el nº que
' le precede, que se supone que es lo que deseamos. El 3 y el 6 es la posicion
' de los separadores.
' .-Se le llama desde el evento KeyDown del textbox y le pasamos como
' argumento el argumento (KeyCode) del propio evento y el propio textbox
'
Public Function Borrando(ByVal KeyCod As MSForms.ReturnInteger, _
ByVal TextBx As MSForms.TextBox) As Boolean
Borrando = (KeyCod = vbKeyBack) And ((Len(TextBx.Text) = 3 _
Or Len(TextBx.Text) = 6))
End Function
'
'-
' .-Para validar el contenido si este no esta completo. Toma como base el dia en curso
' segun el nº de caracteres. Es decir, si solo se introduce un digito y se sale,
' el digito equivaldria al dia del mes en curso del año en curso, si se introduce
' hasta el mes añade el año en curso. OJO: si no se introduce nada, devuelve el dia
' en curso. (se puede cambiar facilmente)
' .-El argumento es el contenido del textbox y se le puede llamar desde el Exit
'
Public Function Mascara_De_Salida(Parcial As String, _
Optional sep As String = Separador) As String
Dim L As Byte, Dia As String, Modelo As String, Patron As String
Patron = "dd" & sep & "mm" & sep & "yy"
L = Len(Parcial): Modelo = Format(Now, Patron)
Select Case L
Case Is = 0: Dia = Modelo
Case Is = 1: Dia = "0" & Parcial & Right(Modelo, 6)
Case Is = 4, Is = 7: Dia = Left(Parcial, L - 1) & "0" & _
Right(Parcial, 1) & Right(Modelo, 8 - (L + 1))
Case Is = 8: Dia = Parcial
Case Else: Dia = Parcial & Right(Modelo, 8 - L)
End Select
On Error Resume Next
Mascara_De_Salida = Dia
End Function
'
'-
' .-Este procedimiento es la 'verdadera' mascara de entrada, y va
' condicionando el texto del textbox segun cada nuevo caracter
' introcducido en el textbox, para que sea coherente con el formato
' de fecha dd mm aa. OJO: solo es valido para esta configuracion
' regional. La mejor forma de entender su funcionamiento es ir
' 'desguazandolo' de arriba a abajo con la ayuda de la 'logica'
' y de ... F1. Aunque al final lo he llenado de comentarios.
' .-Hay que llamarlo desde el evento change del textbox y
' le pasamos como argumentos el propio Textbox, la variable boolean
' que hemos declarado a nivel del modulo del formulario y el separador
' de fechas que queramos usar (este es opcional porque aunque inicialmente
' estaba pensado para la barra, en una consulta lo pedian con guion
' medio y en aquel ejemplo se daba a elegir el separador en un combo)
' Si se omite se asume la constante Separador (que tambien puede cambiarse)
'
Public Sub Mascara_Fecha_1(ByRef TextB As MSForms.TextBox, _
ByRef b_Borrar As Boolean, Optional sep As String = Separador)
Dim nLen As Byte, Ult As String, max As Byte ' Max es el maximo de dias o meses
' nLen es el nº de caracteres en el textbox, Ult es el ultimo escrito

With TextB ' con el TextBox pasado
' si esta vacio devolvemos a falso la variable pasada (por si se hubiera
' borrado con la tecla retroceso <creo que no hace falta, pero..>)y salimos
If .Text = "" Then b_Borrar = False: Exit Sub
nLen = Len(.Text): Ult = Mid(.Text, nLen, 1) ' inicializamos nLen y Ult

Select Case nLen ' segun el nº de caracteres en el textbox

Case Is = 1 ' si es 1 y el caracter introducido ..
' no es numero o su valor es mayor que 3 [por los 31 dias], lo borramos
If Not IsNumeric(Ult) Or Val(Ult) > 3 Then .Text = ""

Case Is = 2, Is = 5 ' si es 2 o es 5 inicializamos Max segun sea uno u otro
If nLen = 2 Then max = 31 Else max = 12
' si no es numero el ultimo caracter o si su valor concatenado con el
' anterior es menor de 1 o es mayor que max borramos el ultimo caracter
If Not IsNumeric(Ult) Or _
Val(Mid(.Text, nLen - 1, 1) & Ult) > max Or _
Val(Mid(.Text, nLen - 1, 1) & Ult) < 1 Then
.Text = Left(.Text, nLen - 1)
Else ' si no es asi
' comprobamos que en caso de ser el 5º caracter el mes no entra en
' contradicion con el dia (meses de 28, 29, 30 o 31 dias). Si es asi
' borramos el ultimo, si es correcto ponemos el separador
If nLen = 5 And Not IsDate(.Text & sep & "00") Then _
.Text = Left(.Text, nLen - 1) Else .Text = .Text & sep
End If

Case Is = 3, Is = 6 ' si es 3 o 6 (el separador) y se ha pulsado la tecla
' retroceso borramos el separador y el nº que le precede
If b_Borrar Then .Text = Left(.Text, nLen - 2)
If .Text = "0" Then .Text = "" ' si el textbox es = 0 lo borramos

Case Is = 4, Is = 7 ' si es 4 o es 7
' si no es nº o nLen = 4 y el ult es mayor que 1 (por 12 meses) lo borramos
If Not IsNumeric(Ult) Or (nLen = 4 And Val(Ult) > 1) Then _
.Text = Left(.Text, nLen - 1)

Case Is = 8 ' si es 8, si no es nº borramos ult, y si es nº pero el dia es 29
' y el mes 2, comprobamos si el año es bisiesto y borramos ult si no es asi
If Not IsNumeric(Ult) Or (Left(.Text, 2) = _
"29" And Mid(.Text, 4, 2) = "02" And _
Val(Right(.Text, 2)) Mod 4 > 0) Then _
.Text = Left(.Text, 7)

Case Is > 8 ' impedimos introducir mas de 8 caracteres
.Text = Left(.Text, 8)
End Select
End With
b_Borrar = False ' volvemos a false para prevenir proximo teclazo retroceso
End Sub
'
'Mascara 2 (permite escribir el dia y/o el mes con un solo digito --'
'
' .-En este caso la mascara permite escribir el dia y/o el mes con un solo nº.
' El funcionamiento es practicamente igual a la mascara 1 pero si el caracter
' introducido corresponde al 1º del dia o del mes:
' a) si es mayor que el permitido (3 para los dias y 1 para los meses),
' automaticamente asume que se quiere introducir con un solo digito y se
' pone un '0' delante y el separador detras
' b) si el siguiente caracter introducido es el separador, se coloca un '0'
' delante del nº
'
Public Sub Mascara_Fecha_2(ByRef TextB As MSForms.TextBox, _
ByRef b_Borrar As Boolean, Optional sep As String = Separador)
Dim nLen As Byte, Ult As String
With TextB
If .Text = "" Then b_Borrar = False: Exit Sub
nLen = Len(.Text): Ult = Mid(.Text, nLen, 1)
Select Case nLen
Case Is = 1
If Not IsNumeric(Ult) Then
.Text = ""
ElseIf Val(Ult) > 3 Then
.Text = "0" & Ult & sep
End If
Case Is = 2
If (Not IsNumeric(Ult) And Ult <> sep) Or _
(Ult <> sep And (Val(.Text) > 31) Or _
(Val(.Text) < 1)) Then
.Text = Left(.Text, 1)
ElseIf Ult = sep Then
.Text = "0" & .Text
Else
.Text = .Text & sep
End If
Case Is = 3, Is = 6
If b_Borrar Then .Text = Left(.Text, nLen - 2)
Case Is = 4
If Not IsNumeric(Ult) Then
.Text = Left(.Text, 3)
ElseIf Val(Ult) > 1 Then
.Text = Left(.Text, 3) & "0" & Ult & sep
End If
Case Is = 5
If (Not IsNumeric(Ult) And Ult <> sep) Or (Ult <> sep And _
(Val(Mid(.Text, 4, 2)) > 12 Or Val(Mid(.Text, 4, 2)) < 1)) Then
.Text = Left(.Text, 1)
ElseIf Ult = sep Then
.Text = Left(.Text, 3) & "0" & Right(.Text, 2)
Else
.Text = .Text & sep
End If
Case Is = 7
If Not IsNumeric(Ult) Then .Text = Left(.Text, 6)
Case Is = 8
If Not IsNumeric(Ult) Or (Left(.Text, 2) = _
"29" And Mid(.Text, 4, 2) = "02" And _
Val(Right(.Text, 2)) Mod 4 > 0) Then _
.Text = Left(.Text, 7)
Case Is > 8
.Text = Left(.Text, 8)
End Select
End With
b_Borrar = False
End Sub
'
'***************************** fin modulo normal *****************************************

.-y para probarlo por ej. se podria hacer esto (OJO: aunque el evento exit y la mascara de salida se puede omitir, no
asi el
codigo del evento KeyDown, que se debe poner siempre para evitar errores

'***************************** en el modulo del formulario ********************************
'
' Proyecto : VBAProj_Mascara_Fecha_TextBox
' Módulo : frm_Pruebas_Mascara
' Fecha : 02/10/07 16:36
' Autor : Ivan
' Proposito : probar las mascaras e fechas en dos textbox
' Requisitos: en un UserForm:
' _ 2 Textbox (llamados TextBox1 y TextBox2)
' _ 2 Label (Label1 y Label2) para verlo mejor se pueden colocar
' el 1 detras del textbox1 y el 2 detras del textbox2
' _ 1 ComboBox (CombBox1)
'
'
Option Explicit
'
'
Dim Borrar As Boolean, opSep As String ' opSep se puede quitar si omitimos
' el argumento en las mascaras, pero
' lo dejo por si se quiere probar

' -- para alternar el separador
'
Private Sub ComboBox1_Change()
opSep = IIf(ComboBox1.ListIndex = -1, Separador, ComboBox1.Text)
TextBox1 = "": TextBox2 = ""
End Sub
'
'-TextBox1 con Mascara_1 -
'
Private Sub TextBox1_Change()
Mascara_Fecha_1 TextBox1, Borrar, opSep
Label1 = Mascara_De_Salida(TextBox1.Text, opSep)
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Text = Mascara_De_Salida(TextBox1.Text, opSep)
TextBox2.SetFocus: TextBox1.TabIndex = TextBox2.TabIndex + 1
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Borrar = Borrando(KeyCode, TextBox1)
End Sub
'
'TextBox2 con Mascara_2 -
'
Private Sub TextBox2_Change()
Mascara_Fecha_2 TextBox2, Borrar, opSep
Label2 = Mascara_De_Salida(TextBox2.Text, opSep)
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox2.Text = Mascara_De_Salida(TextBox2.Text, opSep)
TextBox2.TabIndex = TextBox1.TabIndex + 1
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Borrar = Borrando(KeyCode, TextBox2)
End Sub
'
' userform --
Private Sub UserForm_Initialize()
opSep = Separador
With ComboBox1
.AddItem "/"
.AddItem "-"
.Text = Separador
End With
TextBox1.SetFocus
End Sub
' ************************** fin modulo formulario ***********************


un saludo
Ivan