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 = TrueText3.Enabled = TrueText4.Enabled = TrueText1.SetFocusEnd SubPrivate Sub Command2_Click()Text2.Text = DateSelect Case (Weekday(Date) - 1)Case 0Text2.Text = Text2.Text + " 星期日"Case 1Text2.Text = Text2.Text + " 星期一"Case 2Text2.Text = Text2.Text + " 星期二"Case 3Text2.Text = Text2.Text + " 星期三"Case 4Text2.Text = Text2.Text + " 星期四"Case 5Text2.Text = Text2.Text + " 星期五"Case 6Text2.Text = Text2.Text + " 星期六"End SelectText1.Text = ""Text3.Text = ""Text4.Text = ""Text1.Enabled = FalseText3.Enabled = FalseText4.Enabled = FalseEnd SubPrivate Sub Text1_Change()If Len(Text1.Text) = 4 ThenText3.SetFocusEnd IfEnd SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)Select Case KeyAsciiCase Asc("0") To Asc("9")Case ElseKeyAscii = 0End SelectEnd SubPrivate Sub Text2_GotFocus()Text2.Text = DateSelect Case (Weekday(Date) - 1)Case 0Text2.Text = Text2.Text + " 星期日"Case 1Text2.Text = Text2.Text + " 星期一"Case 2Text2.Text = Text2.Text + " 星期二"Case 3Text2.Text = Text2.Text + " 星期三"Case 4Text2.Text = Text2.Text + " 星期四"Case 5Text2.Text = Text2.Text + " 星期五"Case 6Text2.Text = Text2.Text + " 星期六"End SelectText1.Text = ""Text3.Text = ""Text4.Text = ""Text1.Enabled = FalseText3.Enabled = FalseText4.Enabled = FalseEnd SubPrivate Sub Text2_KeyPress(KeyAscii As Integer) Select Case KeyAsciiCase 48 To 57Case ElseKeyAscii = 0End SelectEnd SubPrivate Sub Text3_Change()Dim c As Integerc = Val(Text3.Text)If c <= 12 And Len(Trim(Text3.Text)) = 2 ThenText4.SetFocusElseIf Val(Text3.Text) >= 13 ThenText2.Text = "没有这一个月份"Text3.Text = ""End IfEnd SubPrivate Sub Text3_KeyPress(KeyAscii As Integer)Select Case KeyAsciiCase 48 To 57Case ElseKeyAscii = 0End SelectEnd SubPrivate Sub Text4_Change()Select Case Text3.TextCase "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) - 1Select Case (y)Case 0Text2.Text = "星期日"Case 1Text2.Text = "星期一"Case 2Text2.Text = "星期二"Case 3Text2.Text = "星期三"Case 4Text2.Text = "星期四"Case 5Text2.Text = "星期五"Case 6Text2.Text = "星期六"End SelectElseIf Val(Text4.Text) >= 32 ThenText2.Text = "没有这一天"Text4.Text = ""End IfCase "04", "06", "09", "11"If Val(Text4.Text) <= 30 And Len(Text4.Text) = 2 Thenx = DateSerial(Text1.Text, Text3.Text, Text4.Text)y = Weekday(x) - 1Select Case (y)Case 0Text2.Text = "星期日"Case 1Text2.Text = "星期一"Case 2Text2.Text = "星期二"Case 3Text2.Text = "星期三"Case 4Text2.Text = "星期四"Case 5Text2.Text = "星期五"Case 6Text2.Text = "星期六"End SelectElseIf Val(Text4.Text) >= 31 ThenText2.Text = "没有这一天"Text4.Text = ""End IfCase "02"Dim t As Integert = Text1.TextIf t Mod 100 = 0 ThenIf t Mod 400 = 0 Thenm = TrueElse: m = FalseEnd IfElseIf t Mod 4 = 0 Thenm = TrueElse: m = FalseEnd IfIf m = 1 ThenIf Val(Text4.Text) <= 29 And Len(Text4.Text) = 2 Thenx = DateSerial(Text1.Text, Text3.Text, Text4.Text)y = Weekday(x) - 1Select Case (y)Case 0Text2.Text = "星期日"Case 1Text2.Text = "星期一"Case 2Text2.Text = "星期二"Case 3Text2.Text = "星期三"Case 4Text2.Text = "星期四"Case 5Text2.Text = "星期五"Case 6Text2.Text = "星期六"End SelectElseIf Val(Text4.Text) >= 30 ThenText2.Text = "没有这一天"Text4.Text = ""End IfElseIf Val(Text4.Text) <= 28 And Len(Text4.Text) = 2 Thenx = DateSerial(Text1.Text, Text3.Text, Text4.Text)y = Weekday(x) - 1Select Case (y)Case 0Text2.Text = "星期日"Case 1Text2.Text = "星期一"Case 2Text2.Text = "星期二"Case 3Text2.Text = "星期三"Case 4Text2.Text = "星期四"Case 5Text2.Text = "星期五"Case 6Text2.Text = "星期六"End SelectElseIf Val(Text4.Text) >= 29 ThenText2.Text = "没有这一天"Text4.Text = ""End IfEnd IfEnd SelectEnd Sub。