Private Function AjustarHora(ByVal sFecha As String) As String
' Ajustar la cadena introducida a formato de hora
Dim sHora As String
sHora = Form.TextBox.Text
'Si 8 caracteres y formato incorrecto
If Len(sHora) = 8 Then
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 _
Or Mid(sHora, 6, 1) <> ":" _
Or Val(Mid(sHora, 7, 2)) > 59 Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
If Len(sHora) = 7 Then
'Si 7 caracteres y formato correcto
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 2)) <= 59 _
And Mid(sHora, 6, 1) = ":" _
And Val(Mid(sHora, 7, 1)) <= 5 Then
sHora = sHora & "0"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 7 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 _
Or Mid(sHora, 6, 1) <> ":" _
Or Val(Mid(sHora, 7, 1)) > 5 Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 6 caracteres y formato correcto
If Len(sHora) = 6 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 2)) <= 59 _
And Mid(sHora, 6, 1) = ":" Then
sHora = sHora & "00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 6 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 _
Or Mid(sHora, 6, 1) <> ":" Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 5 caracteres y formato correcto
If Len(sHora) = 5 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 2)) <= 59 Then
sHora = sHora & ":00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 Then
'Si 5 caracteres y formato incorrecto
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 4 caracteres y formato correcto
If Len(sHora) = 4 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 1)) <= 5 Then
sHora1 = Left(sHora, 3)
sHora2 = Mid(sHora, 4, 1)
sHora = sHora1 & "0" & sHora2 & ":00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 4 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 1)) > 5 Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si tiene caracteres y formato correcto
If Len(sHora) = 3 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" Then
sHora = sHora & "00:00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 3 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 2 caracteres y formato correcto
If Len(sHora) = 2 Then
If Val(Mid(sHora, 1, 2)) <= 23 Then
sHora = sHora & ":00:00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
If Val(Mid(sHora, 1, 2)) > 23 Then
'Si 2 caracteres y formato incorrecto
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 1 caracter
If Len(sHora) = 1 Then
If Val(Mid(sHora, 1, 1)) <= 9 Then
sHora = "0" & sHora & ":00:00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
End If
'Si cadena vacía
If Form.TextBox.Text = "" Then
AjustarHora = "00:00:00"
Form.TextBox.Text = AjustarHora
Exit Function
End If
End Function
Similar topics (5)
Julio 26, 2010, 11:11:14 am