Muy buenas a todos de ante mano mil gracias por su valiosa ayuda:
En un Userform con 2 TextBox, TextBox1 para ingresar la fecha de nacimiento
y Textbox 2 para el resultado con el sgte còdigo:
- En el TextBox1:
On Error GoTo Fin
If KeyCode = vbKeyReturn Then TextBox1 = DateDiff("yyyy",
CLng(CDate(TextBox2)), Date)
Fin:
Para la màscar de entrada al estilo de Acces tengo la sgte funciòn:
Function Mascara_Fecha(ByRef TextB As MSForms.TextBox, _
ByRef b_Borrar As Boolean)
Dim n As Byte, nl As Byte, lt As String, max As Byte
With TextB
If .Text = "" Then b_Borrar = False: Exit Function
nl = Len(.Text): lt = Mid(.Text, nl, 1)
Select Case nl
Case Is = 1
If Not IsNumeric(lt) Or Val(lt) > 3 Then .Text = ""
Case Is = 2, Is = 5
If nl = 2 Then max = 31 Else max = 12
If Not IsNumeric(lt) Or _
(Mid(.Text, nl - 1, 1) & lt) > max Or _
Val(Mid(.Text, nl - 1, 1) & lt) < 1 Then
.Text = Left(.Text, nl - 1)
Else
If nl = 5 And Not IsDate(.Text & "/00") Then _
.Text = Left(.Text, nl - 1) Else _
.Text = .Text & "/"
End If
Case Is = 3, Is = 6
If b_Borrar Then .Text = Left(.Text, nl - 2)
Case Is = 4
If Not IsNumeric(lt) Or _
Val(lt) > 1 Then .Text = Left(.Text, nl - 1)
Case Is = 8
If Not IsNumeric(lt) 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)
Case Else
If Not IsNumeric(lt) Then .Text = Left(.Text, nl - 1)
End Select
End With
b_Borrar = False
End Function
En el TextBox1:
Private Sub TextBox1_Change()
Dim Borrar As Boolean
Mascara_Fecha TextBox1, Borrar
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
If KeyCode = vbKeyBack Then Borrar = True
End Sub
Ahora bien todo èsto funciona perfectamente el problema es cuando la fecha
de nacimiento es menor a 1929 me arroja error.
Intento modificar la fecha en la configuraciòn regional pero es imposible ya
que èsta opciòn està descativada.
S@lu2..
Beneco
Leer las respuestas