我有一个代码,允许我在textbox1中手动输入日期,然后在useform的日历中选择日期。还有第二个文本框允许我添加或减去日期。代码完美无缺。
用户形式代码 -
Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox1.Value) Then Me.Calendar1.Value = Me.TextBox1.Value
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date
With Me
If IsDate(.TextBox1.Value) Then
dt = CDate(.TextBox1.Value) + Val(.TextBox2.Value)
.TextBox1.Value = dt
.Calendar1.Value = dt
End If
End With
End Sub
我想以特定格式在textbox1中手动输入日期。
格式为 -
DD
DDMMM
ddmmmyyy
我不确定如何编写执行此操作的代码。
我们的想法是在textbox1中以上面指定的3种格式之一输入日期,然后在用户表单的日历上选择该日期。
答案 0 :(得分:0)
已编辑
您可以构建以下代码
Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim txt As String, dayStr As String, monthStr As String, yearStr As String
Dim okTxt As Boolean
txt = Me.TextBox1.Value
Select Case Len(txt)
Case 2
dayStr = txt
okTxt = okDay(dayStr)
monthStr = month(Now)
yearStr = year(Now)
Case 5
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr)
yearStr = year(Now)
Case 7
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
yearStr = Mid(txt, 6, 2)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr)
End Select
If Not okTxt Then
MsgBox "Invalid date" _
& vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _
& vbCrLf & vbTab & "dd" _
& vbCrLf & vbTab & "ddmmm" _
& vbCrLf & vbTab & "ddmmmyy" _
& vbCrLf & vbCrLf & "Please try again", vbCritical
Cancel = True
Else
Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr)
End If
End Sub
Function okDay(txt As String) As Boolean
okDay = CInt(txt) > 0 And CInt(txt) < 31
End Function
Function okMonth(txt As String) As Boolean
Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC"
okMonth = InStr(months, UCase(txt)) > 0
End Function
Function okYear(txt As String) As Boolean
okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years
End Function