Fecha en inputbox Excel VBA

Una vez más tengo una pregunta...
Estoy solicitando por medio de un inputbox una fecha para hacer unos cálculos, luego la fecha la coloco en una celda...
Así es como solicito la fecha...
dim x
x = InputBox("Escribe la fecha de vencimiento")    
            Do While Not IsDate(x)
                If x <> "" Then
                    p = MsgBox("Formato de fecha incorrecto. ", vbCritical)
                    x = InputBox("Escriba la fecha de vencimiento ")
                Else
                    End
                End If
            Loop
Cómo pueden ver... Al utilizar IsDate la fecha toma ese formato... El problema es que yo NO puedo trabajar con el formato mes/día/año... Sino al contrario día/mes/año
como puedo hacer para que me acepte la fecha con este formato.. ¿dd/mm/aaaa
y poder validarlo para que me salga un mensaje de ErrOR en caso de que sea una fecha no válida?

1 respuesta

Respuesta
2
Copia estas funciones en un módulo:
Function convertirTextoAFecha(ByVal txtFecha As String) As Variant
    Dim dd As String
    Dim mm As String
    Dim aa As String
    ' Primero comprobamos que la fecha sea correcta
    If snFechaValida(txtFecha) Then
        ' Separamos los 3 datos
        dd = Mid$(txtFecha, 1, 2)
        mm = Mid$(txtFecha, 4, 2)
        aa = Mid$(txtFecha, 7, 4)
        ' Convertimos a formato fecha
        convertirTextoAFecha = DateSerial(Val(aa), Val(mm), Val(dd))
      Else
        convertirTextoAFecha = Null
    End If
End Function
Function snFechaValida(ByVal txtFecha As String) As Boolean
    Dim dd As String
    Dim mm As String
    Dim aa As String
    Dim auxFecha As Date
    ' Esta función valida el formato de la fecha y da un mensaje si no lo es.
    snFechaValida = False ' Hasta que demostremos lo contrario
    ' Tiene que tener 10 caracteres
    If Len(txtFecha) <> 10 Then GoTo etFechaInvalida
    ' El carácter 3 y el 6 serán un "/" o un "-" (ambos el mismo)
    If (Mid$(txtFecha, 3, 1) <> "/" Or Mid$(txtFecha, 6, 1) <> "/") And _
       (Mid$(txtFecha, 3, 1) <> "-" Or Mid$(txtFecha, 6, 1) <> "-") Then GoTo etFechaInvalida
    ' Separamos los 3 datos
    dd = Mid$(txtFecha, 1, 2)
    mm = Mid$(txtFecha, 4, 2)
    aa = Mid$(txtFecha, 7, 4)
    ' Comprobamos que los datos separados sean números
    If Not IsNumeric(dd) Or Not IsNumeric(mm) Or Not IsNumeric(aa) Then GoTo etFechaInvalida
    ' Por último, sabremos que la fecha está bien escrita si al pasarlo a un campo de tipo fecha
' y volver a convertirlo a texto nos da lo mismo que tenemos
auxFecha = DateSerial(Val(aa), Val(mm), Val(dd))
     If Format$(auxFecha, "yyyymmdd") <> aa & mm & dd Then GoTo etFechaInvalida
     snFechaValida = True
     Exit Function
etFechaInvalida:
        MsgBox "La fecha no tiene formato dd/mm/aaaa"
End Function
Una vez definidas esas dos funciones, tu código quedaría de la siguiente forma:
    Dim x
    Dim fecha As Variant ' Para guardar el texto en formato fecha
    Do
        x = InputBox("Escribe la fecha de vencimiento")
        If x = "" Then End ' Ha pulsado cancelar
        fecha = convertirTextoAFecha(x) ' Si la fecha es incorrecta da el mensaje y devuelve nulo
    Loop Until Not IsNull(fecha) ' Si no es nulo es porque la fecha era correcta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas