简易日历代码
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
Dim x As Variant, y As Variant, z As Integer, m As Boolean Private Sub Command1_Click()
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text1.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text1.SetFocus
End Sub
Private Sub Command2_Click()
Text2.Text = Date
Select Case (Weekday(Date) - 1)
Case 0
Text2.Text = Text2.Text + " 星期日"
Case 1
Text2.Text = Text2.Text + " 星期一"
Case 2
Text2.Text = Text2.Text + " 星期二"
Case 3
Text2.Text = Text2.Text + " 星期三"
Case 4
Text2.Text = Text2.Text + " 星期四"
Case 5
Text2.Text = Text2.Text + " 星期五"
Case 6
Text2.Text = Text2.Text + " 星期六"
End Select
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text1.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
End Sub
Private Sub Text1_Change()
If Len(Text1.Text) = 4 Then
Text3.SetFocus
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub Text2_GotFocus()
Text2.Text = Date
Select Case (Weekday(Date) - 1)
Case 0
Text2.Text = Text2.Text + " 星期日"
Case 1
Text2.Text = Text2.Text + " 星期一"
Case 2
Text2.Text = Text2.Text + " 星期二"
Case 3
Text2.Text = Text2.Text + " 星期三"
Case 4
Text2.Text = Text2.Text + " 星期四"
Case 5
Text2.Text = Text2.Text + " 星期五"
Case 6
Text2.Text = Text2.Text + " 星期六"
End Select
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text1.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub Text3_Change()
Dim c As Integer
c = Val(Text3.Text)
If c <= 12 And Len(Trim(Text3.Text)) = 2 Then
Text4.SetFocus
ElseIf Val(Text3.Text) >= 13 Then
Text2.Text = "没有这一个月份"
Text3.Text = ""
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub Text4_Change()
Select Case Text3.Text
Case "01", "03", "05", "07", "08", "10", "12"
If Val(Text4.Text) <= 31 And Len(Trim(Text4.Text)) = 2 Then x = DateSerial(Text1.Text, Text3.Text, Text4.Text)
y = Weekday(x) - 1
Select Case (y)
Case 0
Text2.Text = "星期日"
Case 1
Text2.Text = "星期一"
Case 2
Text2.Text = "星期二"
Case 3
Text2.Text = "星期三"
Case 4
Text2.Text = "星期四"
Case 5
Text2.Text = "星期五"
Case 6
Text2.Text = "星期六"
End Select
ElseIf Val(Text4.Text) >= 32 Then
Text2.Text = "没有这一天"
Text4.Text = ""
End If
Case "04", "06", "09", "11"
If Val(Text4.Text) <= 30 And Len(Text4.Text) = 2 Then