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?
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 de santiagomf
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
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
