Codigo para controlar la pulsacion de una fecha???

"Técnicos Aydai" escribió en el mensaje
news:

Hola a todos!!!

Perdonad, pero teneis alguien el codigo o la regex necesaria para
controlar
la pulsacion de una fecha dentro de un textbox.???

Gracias.

Hola:

Para "controlar la pulsacion" basta con agregar un manejador para el evento
Click :-)
Si lo que quieres es validar una fecha, tienes al menos dos opciones:

La funcion Microsoft.VisualBasic.IsDate
If Not IsDate(TextBox1.Text) Then
msgBox("Fecha Invalida")
End If

Llamar a Date.Parse controlando la excepcion que podria producirse si la
fecha es invalida.
Try
Dim dt As Date = Date.Parse(TextBox1.Text)
TextBox1.Text =
dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.ShortDatePattern)
Catch ex As Exception
MsgBox("Fecha Invalida:" & ex.Message)
End Try

Nota que en el segundo ejemplo, adicionalmente se formatea el contenido de
TextBox1 segun el patron definido para la fecha corta en la configuracion
regional del equipo.

Salud!

Hola Leonardo!! Muchas gracias por tu respuesta, pero no es exactamente lo
que busco, ya que lo que yo quiero es que cuando se pulse alguna tecla
dentro del textbox, solo pueda ser con el formato dd/mm/yyyy o dd/mm/yy.

Gracias de todas formas.

"Leonardo Azpurua [mvp vb]" <l e o n a r d o (arroba) m v p s (punto) o r g>
escribió en el mensaje news:

"Técnicos Aydai" escribió en el mensaje
news:
> Hola a todos!!!
>
> Perdonad, pero teneis alguien el codigo o la regex necesaria para
> controlar
> la pulsacion de una fecha dentro de un textbox.???
>
> Gracias.

Hola:

Para "controlar la pulsacion" basta con agregar un manejador para el

evento

Click :-)
Si lo que quieres es validar una fecha, tienes al menos dos opciones:

La funcion Microsoft.VisualBasic.IsDate
If Not IsDate(TextBox1.Text) Then
msgBox("Fecha Invalida")
End If

Llamar a Date.Parse controlando la excepcion que podria producirse si la
fecha es invalida.
Try
Dim dt As Date = Date.Parse(TextBox1.Text)
TextBox1.Text >

dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.S
hortDatePattern)

Catch ex As Exception
MsgBox("Fecha Invalida:" & ex.Message)
End Try

Nota que en el segundo ejemplo, adicionalmente se formatea el contenido de
TextBox1 segun el patron definido para la fecha corta en la configuracion
regional del equipo.

Salud!

Esta función la saqué de J.P. Leyten que a su vez partió del ActiveX:
effMaskedEdit la URL es:
luego la modifiqué a mi gusto, la utilizo en VB6 por lo que tiene unos
cuantos años. Le pasamos la tecla que se pulsa y nos valida si es correcta.
No solo la uso para fechas, tambíén para números y alguna cosa más.

KeyAscii=Tecla pulsada
eAllowed=Enum de tipos de campos, si vas a controlar fechas no te hace
falta.
Suprimir= Hay campos en los que no me interesa suprimir y bloqueo la tecla.

'Meollo de la cuestión. Aquí se produce toda la validación de
'las teclas pulsadas, no del campo introducido, sólo de la tecla
'que hemos pulsado en el campo en el que estamos situados.
' Original Code produced by TheFrogPrince
Private Function OnKeyPress(ByVal KeyAscii As KeyCodeConstants, ByVal
eAllowed As AllowedKeys, Suprimir As Boolean) As Integer
Dim Dia As String, Mes As String, Anno As String
Dim Paso As String 'Para hacer con ella lo que queramos
Dim Posicion As Integer, PosicionAnt As Integer 'Para saber donde esta
Dim PosAnno As Integer 'el cursor

' Allow All System Keys Through
If KeyAscii < 32 Then
' AutoTab
If m_AutoTab And KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
End If
'Las siguientes líneas es para que en la fecha no me borre
'las barras y así queda precioso. Es un coñazo pero queda bien
'Las propiedades del LENGHT son las que
If m_AllowedKeys = OnlyDate And KeyAscii = vbKeyBack Then
'El año lo dejo al libre albedrío
If VariantBox.SelStart > 0 And VariantBox.SelStart < 7 Then
'Si borro y existe la barra me paso al anterior
'si no borro directamente
If Mid(VariantBox, VariantBox.SelStart, 1) = "/" Then
VariantBox.SelStart = VariantBox.SelStart - 2
Else
VariantBox.SelStart = VariantBox.SelStart - 1
End If
VariantBox.SelLength = 1
VariantBox.SelText = " "
VariantBox.SelStart = VariantBox.SelStart - 1
KeyAscii = 0
Else 'Si tengo marcado el campo lo borro
If VariantBox.SelLength > 0 Then
VariantBox = " / / "
VariantBox.SelLength = 0
KeyAscii = 0
End If
End If
End If
OnKeyPress = KeyAscii
Exit Function
End If
'Capturo SUPRIMIR para que no haga cosas raras
If KeyAscii = vbKeyDelete And Suprimir Then
If m_AllowedKeys = OnlyDate Then
Paso = Left(VariantBox, 2) + Mid(VariantBox, 4, 2) +
Mid(VariantBox, 7, 4)
PosicionAnt = VariantBox.SelStart
If VariantBox.SelStart > 0 Then
'Borro el caracter donde estoy situado y me quedo
'para no mover la barra de separción
Select Case VariantBox.SelStart
Case 0 To 1
Posicion = VariantBox.SelStart
Case 3 To 4
Posicion = VariantBox.SelStart - 1
Case 6 To 7
Posicion = VariantBox.SelStart - 2
End Select
Paso = Left(Paso, Posicion) + Mid(Paso, Posicion + 2, 10)
Else
If VariantBox.SelLength > 0 Then
Paso = ""
VariantBox.SelLength = 0
KeyAscii = 0
Else
Paso = Mid(Paso, 2, 10)
End If
End If
Paso = Paso & Space(10 - Len(Paso))
KeyAscii = 0
VariantBox = Mid(Paso, 1, 2) + "/" + Mid(Paso, 3, 2) + "/" +
Mid(Paso, 5, 4)
VariantBox.SelStart = PosicionAnt
Exit Function
End If
End If

'Si esto al final del campo, ya no puedo insertar más
'caracteres a no ser que esté marcado
If Len(RTrim(VariantBox)) = m_LongCampo Then
'RDev. A veces la fecha está, pero no seleccionada
'al meterse en el else borraría la fecha.
'Comento el if.
If VariantBox.SelLength <> m_LongCampo Then
KeyAscii = 0
Exit Function
Else
If m_AllowedKeys = OnlyDate Then VariantBox = " / / "
End If
End If


' Eliminate In-Eligible Keystrokes
Select Case True
Case KeyAllowed(KeyAscii, eAllowed)
Case KeyNotAllowed(KeyAscii, eAllowed)
KeyAscii = 0
Case (eAllowed And OnlyDate) And (KeyAscii < vbKey0 Or KeyAscii >
vbKey9)
KeyAscii = 0
End Select

' Coerce values
Select Case True
Case (eAllowed And Lowercase)
KeyAscii = Asc(LCase(Chr(KeyAscii)))
Case (eAllowed And UpperCase)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Select

'VALIDACIÓN DE LA ENTRADA DE LA FECHA
'Si hay FALLOS arreglarlo por aquí. TRATO la fecha en 3 partes
'Día, MES y AÑO, y valido la tecla pulsada si corresponde
'con el campo, es decir, no se puede meter día 40, por lo que
'el primer dígito del día no puede ser 4. Si el primero es
'3, el segundo no puede ser 2, etc..
If m_AllowedKeys = OnlyDate Then
Dia = Space(2)
Mes = Space(2)
Anno = Space(4)
Mid(Dia, 1) = RTrim(Left(VariantBox, 2))
Mid(Mes, 1) = RTrim(Mid(VariantBox, 4, 2))
Mid(Anno, 1) = Trim(Mid(VariantBox, 7, 4))
'If funcG.EsNull(Mes) Then Mes = Month(funcG.FechaActual)
'If funcG.EsNull(Anno) Then Anno = Year(funcG.FechaActual)
'Posición es para situarme dónde corresponda. Hace
'que el cursor se pase dónde yo quiera. Nunca dejo que
'se ponga en "/"
Posicion = VariantBox.SelStart
Select Case VariantBox.SelStart
Case 0 To 1 'DIA
'Dígito 1
If Len(RTrim(Dia)) = 0 And KeyAscii < vbKey4 Then
Dia = Chr$(KeyAscii) & " "
Posicion = Posicion + 1
'Dígito 2
ElseIf Len(RTrim(Dia)) = 1 And RTrim(Dia) & Chr(KeyAscii) >
0 And RTrim(Dia) & Chr(KeyAscii) < 32 Then
Dia = RTrim(Dia) & Chr$(KeyAscii)
Posicion = Posicion + 2
'dígito 2 en inserción para introducirlo si
'hemos borrado algo con suprimir.
ElseIf Len(RTrim(Dia)) = 2 And Len(RTrim(Anno)) < 4 Then
Anno = Right(Mes, 1) + Anno
Mes = Right(Dia, 1) & Left(Mes, 1)
If VariantBox.SelStart = 0 Then
Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii) +
Left(Dia, 1)
Posicion = 1
Else
Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii)
Posicion = 3
End If
' Else
' funcG.Mensaje msgDia & RTrim(Dia) & Chr(KeyAscii),
MensajeInformacion
End If
Case 3 To 4 'MES
If Len(RTrim(Mes)) = 0 And KeyAscii < vbKey2 Then
Mes = Chr$(KeyAscii) & " "
Posicion = Posicion + 1
'A continuación valido el mes según el
'día introducido.
ElseIf Len(RTrim(Mes)) = 1 And RTrim(Mes) & Chr(KeyAscii) >
0 And RTrim(Mes) & Chr(KeyAscii) < 13 Then
Select Case (RTrim(Mes) & Chr(KeyAscii))
Case "02" 'Febrero
If Dia < "30" Then
Mes = RTrim(Mes) & Chr(KeyAscii)
Posicion = Posicion + 2
End If
Case "04", "06", "09", "11" '30 días
If Dia < "31" Then
Mes = RTrim(Mes) & Chr$(KeyAscii)
Posicion = Posicion + 2
End If
Case Else '31 días
Mes = RTrim(Mes) & Chr$(KeyAscii)
Posicion = Posicion + 2
End Select
ElseIf Len(RTrim(Mes)) = 2 And Len(RTrim(Anno)) < 4 Then
Anno = Right(Mes, 1) + Anno
If VariantBox.SelStart = 3 Then
Mid(Mes, 1) = Chr(KeyAscii) & Left(Mes, 1)
Posicion = 4
Else
Mid(Mes, 2) = Chr(KeyAscii)
Posicion = 6
End If
End If
Case 6 To 9 'AÑO
PosAnno = VariantBox.SelStart - 6
Anno = Left(Anno, PosAnno) & Chr(KeyAscii) & Mid(Anno,
PosAnno + 1, 4)
Posicion = Posicion + 1
End Select
KeyAscii = 0 'Pongo el nuevo valor en TEXT
VariantBox = Dia & "/" & Mes & "/" & Anno
VariantBox.SelStart = Posicion
VariantBox.SetFocus
End If

OnKeyPress = KeyAscii
End Function


Un saludo
Oscar Montesinos
"Técnicos Aydai" escribió en el mensaje
news:uHB%

Hola Leonardo!! Muchas gracias por tu respuesta, pero no es exactamente lo
que busco, ya que lo que yo quiero es que cuando se pulse alguna tecla
dentro del textbox, solo pueda ser con el formato dd/mm/yyyy o dd/mm/yy.

Gracias de todas formas.

"Leonardo Azpurua [mvp vb]" <l e o n a r d o (arroba) m v p s (punto) o r
g>
escribió en el mensaje news:

"Técnicos Aydai" escribió en el mensaje
news:
> Hola a todos!!!
>
> Perdonad, pero teneis alguien el codigo o la regex necesaria para
> controlar
> la pulsacion de una fecha dentro de un textbox.???
>
> Gracias.

Hola:

Para "controlar la pulsacion" basta con agregar un manejador para el

evento

Click :-)
Si lo que quieres es validar una fecha, tienes al menos dos opciones:

La funcion Microsoft.VisualBasic.IsDate
If Not IsDate(TextBox1.Text) Then
msgBox("Fecha Invalida")
End If

Llamar a Date.Parse controlando la excepcion que podria producirse si la
fecha es invalida.
Try
Dim dt As Date = Date.Parse(TextBox1.Text)
TextBox1.Text >>

dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.S
hortDatePattern)

Catch ex As Exception
MsgBox("Fecha Invalida:" & ex.Message)
End Try

Nota que en el segundo ejemplo, adicionalmente se formatea el contenido
de
TextBox1 segun el patron definido para la fecha corta en la configuracion
regional del equipo.

Salud!

La URL que no la copié en el mensaje anterior es:
http://www.planet-source-code.com/x...owCode.htm
Un saludo
Oscar Montesinos
"DosFlores" escribió en el mensaje
news:%

Esta función la saqué de J.P. Leyten que a su vez partió del ActiveX:
effMaskedEdit la URL es:
luego la modifiqué a mi gusto, la utilizo en VB6 por lo que tiene unos
cuantos años. Le pasamos la tecla que se pulsa y nos valida si es
correcta. No solo la uso para fechas, tambíén para números y alguna cosa
más.

KeyAscii=Tecla pulsada
eAllowed=Enum de tipos de campos, si vas a controlar fechas no te hace
falta.
Suprimir= Hay campos en los que no me interesa suprimir y bloqueo la
tecla.

'Meollo de la cuestión. Aquí se produce toda la validación de
'las teclas pulsadas, no del campo introducido, sólo de la tecla
'que hemos pulsado en el campo en el que estamos situados.
' Original Code produced by TheFrogPrince
Private Function OnKeyPress(ByVal KeyAscii As KeyCodeConstants, ByVal
eAllowed As AllowedKeys, Suprimir As Boolean) As Integer
Dim Dia As String, Mes As String, Anno As String
Dim Paso As String 'Para hacer con ella lo que queramos
Dim Posicion As Integer, PosicionAnt As Integer 'Para saber donde esta
Dim PosAnno As Integer 'el cursor

' Allow All System Keys Through
If KeyAscii < 32 Then
' AutoTab
If m_AutoTab And KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
End If
'Las siguientes líneas es para que en la fecha no me borre
'las barras y así queda precioso. Es un coñazo pero queda bien
'Las propiedades del LENGHT son las que
If m_AllowedKeys = OnlyDate And KeyAscii = vbKeyBack Then
'El año lo dejo al libre albedrío
If VariantBox.SelStart > 0 And VariantBox.SelStart < 7 Then
'Si borro y existe la barra me paso al anterior
'si no borro directamente
If Mid(VariantBox, VariantBox.SelStart, 1) = "/" Then
VariantBox.SelStart = VariantBox.SelStart - 2
Else
VariantBox.SelStart = VariantBox.SelStart - 1
End If
VariantBox.SelLength = 1
VariantBox.SelText = " "
VariantBox.SelStart = VariantBox.SelStart - 1
KeyAscii = 0
Else 'Si tengo marcado el campo lo borro
If VariantBox.SelLength > 0 Then
VariantBox = " / / "
VariantBox.SelLength = 0
KeyAscii = 0
End If
End If
End If
OnKeyPress = KeyAscii
Exit Function
End If
'Capturo SUPRIMIR para que no haga cosas raras
If KeyAscii = vbKeyDelete And Suprimir Then
If m_AllowedKeys = OnlyDate Then
Paso = Left(VariantBox, 2) + Mid(VariantBox, 4, 2) +
Mid(VariantBox, 7, 4)
PosicionAnt = VariantBox.SelStart
If VariantBox.SelStart > 0 Then
'Borro el caracter donde estoy situado y me quedo
'para no mover la barra de separción
Select Case VariantBox.SelStart
Case 0 To 1
Posicion = VariantBox.SelStart
Case 3 To 4
Posicion = VariantBox.SelStart - 1
Case 6 To 7
Posicion = VariantBox.SelStart - 2
End Select
Paso = Left(Paso, Posicion) + Mid(Paso, Posicion + 2, 10)
Else
If VariantBox.SelLength > 0 Then
Paso = ""
VariantBox.SelLength = 0
KeyAscii = 0
Else
Paso = Mid(Paso, 2, 10)
End If
End If
Paso = Paso & Space(10 - Len(Paso))
KeyAscii = 0
VariantBox = Mid(Paso, 1, 2) + "/" + Mid(Paso, 3, 2) + "/" +
Mid(Paso, 5, 4)
VariantBox.SelStart = PosicionAnt
Exit Function
End If
End If

'Si esto al final del campo, ya no puedo insertar más
'caracteres a no ser que esté marcado
If Len(RTrim(VariantBox)) = m_LongCampo Then
'RDev. A veces la fecha está, pero no seleccionada
'al meterse en el else borraría la fecha.
'Comento el if.
If VariantBox.SelLength <> m_LongCampo Then
KeyAscii = 0
Exit Function
Else
If m_AllowedKeys = OnlyDate Then VariantBox = " / / "
End If
End If


' Eliminate In-Eligible Keystrokes
Select Case True
Case KeyAllowed(KeyAscii, eAllowed)
Case KeyNotAllowed(KeyAscii, eAllowed)
KeyAscii = 0
Case (eAllowed And OnlyDate) And (KeyAscii < vbKey0 Or KeyAscii >
vbKey9)
KeyAscii = 0
End Select

' Coerce values
Select Case True
Case (eAllowed And Lowercase)
KeyAscii = Asc(LCase(Chr(KeyAscii)))
Case (eAllowed And UpperCase)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Select

'VALIDACIÓN DE LA ENTRADA DE LA FECHA
'Si hay FALLOS arreglarlo por aquí. TRATO la fecha en 3 partes
'Día, MES y AÑO, y valido la tecla pulsada si corresponde
'con el campo, es decir, no se puede meter día 40, por lo que
'el primer dígito del día no puede ser 4. Si el primero es
'3, el segundo no puede ser 2, etc..
If m_AllowedKeys = OnlyDate Then
Dia = Space(2)
Mes = Space(2)
Anno = Space(4)
Mid(Dia, 1) = RTrim(Left(VariantBox, 2))
Mid(Mes, 1) = RTrim(Mid(VariantBox, 4, 2))
Mid(Anno, 1) = Trim(Mid(VariantBox, 7, 4))
'If funcG.EsNull(Mes) Then Mes = Month(funcG.FechaActual)
'If funcG.EsNull(Anno) Then Anno = Year(funcG.FechaActual)
'Posición es para situarme dónde corresponda. Hace
'que el cursor se pase dónde yo quiera. Nunca dejo que
'se ponga en "/"
Posicion = VariantBox.SelStart
Select Case VariantBox.SelStart
Case 0 To 1 'DIA
'Dígito 1
If Len(RTrim(Dia)) = 0 And KeyAscii < vbKey4 Then
Dia = Chr$(KeyAscii) & " "
Posicion = Posicion + 1
'Dígito 2
ElseIf Len(RTrim(Dia)) = 1 And RTrim(Dia) & Chr(KeyAscii) >
0 And RTrim(Dia) & Chr(KeyAscii) < 32 Then
Dia = RTrim(Dia) & Chr$(KeyAscii)
Posicion = Posicion + 2
'dígito 2 en inserción para introducirlo si
'hemos borrado algo con suprimir.
ElseIf Len(RTrim(Dia)) = 2 And Len(RTrim(Anno)) < 4 Then
Anno = Right(Mes, 1) + Anno
Mes = Right(Dia, 1) & Left(Mes, 1)
If VariantBox.SelStart = 0 Then
Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii) +
Left(Dia, 1)
Posicion = 1
Else
Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii)
Posicion = 3
End If
' Else
' funcG.Mensaje msgDia & RTrim(Dia) & Chr(KeyAscii),
MensajeInformacion
End If
Case 3 To 4 'MES
If Len(RTrim(Mes)) = 0 And KeyAscii < vbKey2 Then
Mes = Chr$(KeyAscii) & " "
Posicion = Posicion + 1
'A continuación valido el mes según el
'día introducido.
ElseIf Len(RTrim(Mes)) = 1 And RTrim(Mes) & Chr(KeyAscii) >
0 And RTrim(Mes) & Chr(KeyAscii) < 13 Then
Select Case (RTrim(Mes) & Chr(KeyAscii))
Case "02" 'Febrero
If Dia < "30" Then
Mes = RTrim(Mes) & Chr(KeyAscii)
Posicion = Posicion + 2
End If
Case "04", "06", "09", "11" '30 días
If Dia < "31" Then
Mes = RTrim(Mes) & Chr$(KeyAscii)
Posicion = Posicion + 2
End If
Case Else '31 días
Mes = RTrim(Mes) & Chr$(KeyAscii)
Posicion = Posicion + 2
End Select
ElseIf Len(RTrim(Mes)) = 2 And Len(RTrim(Anno)) < 4 Then
Anno = Right(Mes, 1) + Anno
If VariantBox.SelStart = 3 Then
Mid(Mes, 1) = Chr(KeyAscii) & Left(Mes, 1)
Posicion = 4
Else
Mid(Mes, 2) = Chr(KeyAscii)
Posicion = 6
End If
End If
Case 6 To 9 'AÑO
PosAnno = VariantBox.SelStart - 6
Anno = Left(Anno, PosAnno) & Chr(KeyAscii) & Mid(Anno,
PosAnno + 1, 4)
Posicion = Posicion + 1
End Select
KeyAscii = 0 'Pongo el nuevo valor en TEXT
VariantBox = Dia & "/" & Mes & "/" & Anno
VariantBox.SelStart = Posicion
VariantBox.SetFocus
End If

OnKeyPress = KeyAscii
End Function


Un saludo
Oscar Montesinos
"Técnicos Aydai" escribió en el mensaje
news:uHB%

Hola Leonardo!! Muchas gracias por tu respuesta, pero no es exactamente
lo
que busco, ya que lo que yo quiero es que cuando se pulse alguna tecla
dentro del textbox, solo pueda ser con el formato dd/mm/yyyy o dd/mm/yy.

Gracias de todas formas.

"Leonardo Azpurua [mvp vb]" <l e o n a r d o (arroba) m v p s (punto) o r
g>
escribió en el mensaje news:

"Técnicos Aydai" escribió en el mensaje
news:
> Hola a todos!!!
>
> Perdonad, pero teneis alguien el codigo o la regex necesaria para
> controlar
> la pulsacion de una fecha dentro de un textbox.???
>
> Gracias.

Hola:

Para "controlar la pulsacion" basta con agregar un manejador para el

evento

Click :-)
Si lo que quieres es validar una fecha, tienes al menos dos opciones:

La funcion Microsoft.VisualBasic.IsDate
If Not IsDate(TextBox1.Text) Then
msgBox("Fecha Invalida")
End If

Llamar a Date.Parse controlando la excepcion que podria producirse si la
fecha es invalida.
Try
Dim dt As Date = Date.Parse(TextBox1.Text)
TextBox1.Text >>>

dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.S
hortDatePattern)

Catch ex As Exception
MsgBox("Fecha Invalida:" & ex.Message)
End Try

Nota que en el segundo ejemplo, adicionalmente se formatea el contenido
de
TextBox1 segun el patron definido para la fecha corta en la
configuracion
regional del equipo.

Salud!

Muchisimas gracias, todo perfecto
"DosFlores" escribió en el mensaje
news:

La URL que no la copié en el mensaje anterior es:

http://www.planet-source-code.com/x...owCode.htm

Un saludo
Oscar Montesinos
"DosFlores" escribió en el mensaje
news:%
> Esta función la saqué de J.P. Leyten que a su vez partió del ActiveX:
> effMaskedEdit la URL es:
> luego la modifiqué a mi gusto, la utilizo en VB6 por lo que tiene unos
> cuantos años. Le pasamos la tecla que se pulsa y nos valida si es
> correcta. No solo la uso para fechas, tambíén para números y alguna cosa
> más.
>
> KeyAscii=Tecla pulsada
> eAllowed=Enum de tipos de campos, si vas a controlar fechas no te hace
> falta.
> Suprimir= Hay campos en los que no me interesa suprimir y bloqueo la
> tecla.
>
> 'Meollo de la cuestión. Aquí se produce toda la validación de
> 'las teclas pulsadas, no del campo introducido, sólo de la tecla
> 'que hemos pulsado en el campo en el que estamos situados.
> ' Original Code produced by TheFrogPrince
> Private Function OnKeyPress(ByVal KeyAscii As KeyCodeConstants, ByVal
> eAllowed As AllowedKeys, Suprimir As Boolean) As Integer
> Dim Dia As String, Mes As String, Anno As String
> Dim Paso As String 'Para hacer con ella lo que queramos
> Dim Posicion As Integer, PosicionAnt As Integer 'Para saber donde

esta

> Dim PosAnno As Integer 'el cursor
>
> ' Allow All System Keys Through
> If KeyAscii < 32 Then
> ' AutoTab
> If m_AutoTab And KeyAscii = 13 Then
> KeyAscii = 0
> SendKeys "{TAB}"
> End If
> 'Las siguientes líneas es para que en la fecha no me borre
> 'las barras y así queda precioso. Es un coñazo pero queda bien
> 'Las propiedades del LENGHT son las que
> If m_AllowedKeys = OnlyDate And KeyAscii = vbKeyBack Then
> 'El año lo dejo al libre albedrío
> If VariantBox.SelStart > 0 And VariantBox.SelStart < 7 Then
> 'Si borro y existe la barra me paso al anterior
> 'si no borro directamente
> If Mid(VariantBox, VariantBox.SelStart, 1) = "/" Then
> VariantBox.SelStart = VariantBox.SelStart - 2
> Else
> VariantBox.SelStart = VariantBox.SelStart - 1
> End If
> VariantBox.SelLength = 1
> VariantBox.SelText = " "
> VariantBox.SelStart = VariantBox.SelStart - 1
> KeyAscii = 0
> Else 'Si tengo marcado el campo lo borro
> If VariantBox.SelLength > 0 Then
> VariantBox = " / / "
> VariantBox.SelLength = 0
> KeyAscii = 0
> End If
> End If
> End If
> OnKeyPress = KeyAscii
> Exit Function
> End If
> 'Capturo SUPRIMIR para que no haga cosas raras
> If KeyAscii = vbKeyDelete And Suprimir Then
> If m_AllowedKeys = OnlyDate Then
> Paso = Left(VariantBox, 2) + Mid(VariantBox, 4, 2) +
> Mid(VariantBox, 7, 4)
> PosicionAnt = VariantBox.SelStart
> If VariantBox.SelStart > 0 Then
> 'Borro el caracter donde estoy situado y me quedo
> 'para no mover la barra de separción
> Select Case VariantBox.SelStart
> Case 0 To 1
> Posicion = VariantBox.SelStart
> Case 3 To 4
> Posicion = VariantBox.SelStart - 1
> Case 6 To 7
> Posicion = VariantBox.SelStart - 2
> End Select
> Paso = Left(Paso, Posicion) + Mid(Paso, Posicion + 2, 10)
> Else
> If VariantBox.SelLength > 0 Then
> Paso = ""
> VariantBox.SelLength = 0
> KeyAscii = 0
> Else
> Paso = Mid(Paso, 2, 10)
> End If
> End If
> Paso = Paso & Space(10 - Len(Paso))
> KeyAscii = 0
> VariantBox = Mid(Paso, 1, 2) + "/" + Mid(Paso, 3, 2) + "/" +
> Mid(Paso, 5, 4)
> VariantBox.SelStart = PosicionAnt
> Exit Function
> End If
> End If
>
> 'Si esto al final del campo, ya no puedo insertar más
> 'caracteres a no ser que esté marcado
> If Len(RTrim(VariantBox)) = m_LongCampo Then
> 'RDev. A veces la fecha está, pero no seleccionada
> 'al meterse en el else borraría la fecha.
> 'Comento el if.
> If VariantBox.SelLength <> m_LongCampo Then
> KeyAscii = 0
> Exit Function
> Else
> If m_AllowedKeys = OnlyDate Then VariantBox = " / / "
> End If
> End If
>
>
> ' Eliminate In-Eligible Keystrokes
> Select Case True
> Case KeyAllowed(KeyAscii, eAllowed)
> Case KeyNotAllowed(KeyAscii, eAllowed)
> KeyAscii = 0
> Case (eAllowed And OnlyDate) And (KeyAscii < vbKey0 Or KeyAscii >
> vbKey9)
> KeyAscii = 0
> End Select
>
> ' Coerce values
> Select Case True
> Case (eAllowed And Lowercase)
> KeyAscii = Asc(LCase(Chr(KeyAscii)))
> Case (eAllowed And UpperCase)
> KeyAscii = Asc(UCase(Chr(KeyAscii)))
> End Select
>
> 'VALIDACIÓN DE LA ENTRADA DE LA FECHA
> 'Si hay FALLOS arreglarlo por aquí. TRATO la fecha en 3 partes
> 'Día, MES y AÑO, y valido la tecla pulsada si corresponde
> 'con el campo, es decir, no se puede meter día 40, por lo que
> 'el primer dígito del día no puede ser 4. Si el primero es
> '3, el segundo no puede ser 2, etc..
> If m_AllowedKeys = OnlyDate Then
> Dia = Space(2)
> Mes = Space(2)
> Anno = Space(4)
> Mid(Dia, 1) = RTrim(Left(VariantBox, 2))
> Mid(Mes, 1) = RTrim(Mid(VariantBox, 4, 2))
> Mid(Anno, 1) = Trim(Mid(VariantBox, 7, 4))
> 'If funcG.EsNull(Mes) Then Mes = Month(funcG.FechaActual)
> 'If funcG.EsNull(Anno) Then Anno = Year(funcG.FechaActual)
> 'Posición es para situarme dónde corresponda. Hace
> 'que el cursor se pase dónde yo quiera. Nunca dejo que
> 'se ponga en "/"
> Posicion = VariantBox.SelStart
> Select Case VariantBox.SelStart
> Case 0 To 1 'DIA
> 'Dígito 1
> If Len(RTrim(Dia)) = 0 And KeyAscii < vbKey4 Then
> Dia = Chr$(KeyAscii) & " "
> Posicion = Posicion + 1
> 'Dígito 2
> ElseIf Len(RTrim(Dia)) = 1 And RTrim(Dia) & Chr(KeyAscii)

> 0 And RTrim(Dia) & Chr(KeyAscii) < 32 Then
> Dia = RTrim(Dia) & Chr$(KeyAscii)
> Posicion = Posicion + 2
> 'dígito 2 en inserción para introducirlo si
> 'hemos borrado algo con suprimir.
> ElseIf Len(RTrim(Dia)) = 2 And Len(RTrim(Anno)) < 4 Then
> Anno = Right(Mes, 1) + Anno
> Mes = Right(Dia, 1) & Left(Mes, 1)
> If VariantBox.SelStart = 0 Then
> Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii)

+

> Left(Dia, 1)
> Posicion = 1
> Else
> Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii)
> Posicion = 3
> End If
> ' Else
> ' funcG.Mensaje msgDia & RTrim(Dia) & Chr(KeyAscii),
> MensajeInformacion
> End If
> Case 3 To 4 'MES
> If Len(RTrim(Mes)) = 0 And KeyAscii < vbKey2 Then
> Mes = Chr$(KeyAscii) & " "
> Posicion = Posicion + 1
> 'A continuación valido el mes según el
> 'día introducido.
> ElseIf Len(RTrim(Mes)) = 1 And RTrim(Mes) & Chr(KeyAscii)

> 0 And RTrim(Mes) & Chr(KeyAscii) < 13 Then
> Select Case (RTrim(Mes) & Chr(KeyAscii))
> Case "02" 'Febrero
> If Dia < "30" Then
> Mes = RTrim(Mes) & Chr(KeyAscii)
> Posicion = Posicion + 2
> End If
> Case "04", "06", "09", "11" '30 días
> If Dia < "31" Then
> Mes = RTrim(Mes) & Chr$(KeyAscii)
> Posicion = Posicion + 2
> End If
> Case Else '31 días
> Mes = RTrim(Mes) & Chr$(KeyAscii)
> Posicion = Posicion + 2
> End Select
> ElseIf Len(RTrim(Mes)) = 2 And Len(RTrim(Anno)) < 4 Then
> Anno = Right(Mes, 1) + Anno
> If VariantBox.SelStart = 3 Then
> Mid(Mes, 1) = Chr(KeyAscii) & Left(Mes, 1)
> Posicion = 4
> Else
> Mid(Mes, 2) = Chr(KeyAscii)
> Posicion = 6
> End If
> End If
> Case 6 To 9 'AÑO
> PosAnno = VariantBox.SelStart - 6
> Anno = Left(Anno, PosAnno) & Chr(KeyAscii) & Mid(Anno,
> PosAnno + 1, 4)
> Posicion = Posicion + 1
> End Select
> KeyAscii = 0 'Pongo el nuevo valor en TEXT
> VariantBox = Dia & "/" & Mes & "/" & Anno
> VariantBox.SelStart = Posicion
> VariantBox.SetFocus
> End If
>
> OnKeyPress = KeyAscii
> End Function
>
>
> Un saludo
> Oscar Montesinos
> "Técnicos Aydai" escribió en el mensaje
> news:uHB%
>> Hola Leonardo!! Muchas gracias por tu respuesta, pero no es exactamente
>> lo
>> que busco, ya que lo que yo quiero es que cuando se pulse alguna tecla
>> dentro del textbox, solo pueda ser con el formato dd/mm/yyyy o

dd/mm/yy.

>>
>> Gracias de todas formas.
>>
>> "Leonardo Azpurua [mvp vb]" <l e o n a r d o (arroba) m v p s (punto) o

r

>> g>
>> escribió en el mensaje news:
>>>
>>> "Técnicos Aydai" escribió en el mensaje
>>> news:
>>> > Hola a todos!!!
>>> >
>>> > Perdonad, pero teneis alguien el codigo o la regex necesaria para
>>> > controlar
>>> > la pulsacion de una fecha dentro de un textbox.???
>>> >
>>> > Gracias.
>>>
>>> Hola:
>>>
>>> Para "controlar la pulsacion" basta con agregar un manejador para el
>> evento
>>> Click :-)
>>> Si lo que quieres es validar una fecha, tienes al menos dos opciones:
>>>
>>> La funcion Microsoft.VisualBasic.IsDate
>>> If Not IsDate(TextBox1.Text) Then
>>> msgBox("Fecha Invalida")
>>> End If
>>>
>>> Llamar a Date.Parse controlando la excepcion que podria producirse si

la

>>> fecha es invalida.
>>> Try
>>> Dim dt As Date = Date.Parse(TextBox1.Text)
>>> TextBox1.Text > >>>
>>

dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.S

>> hortDatePattern)
>>> Catch ex As Exception
>>> MsgBox("Fecha Invalida:" & ex.Message)
>>> End Try
>>>
>>> Nota que en el segundo ejemplo, adicionalmente se formatea el

contenido

>>> de
>>> TextBox1 segun el patron definido para la fecha corta en la
>>> configuracion
>>> regional del equipo.
>>>
>>> Salud!
>>>
>>>
>>
>>
>
>