范诗然：求VB中万年历的算法

迗迗想伱的回答：

代码如下:

Private Sub Command1_Click() Cls x = Text1.Text y = Text2.Text If Text1 = "" Or Text2 = "" Then Text1.SetFocus MsgBox "请输入完整数据!" GoTo a1 End If

Select Case x Case 100 To 9999 GoTo a2 Case Else MsgBox "你所输入的年份不合法,请重新输入!" GoTo a1 End Select

a2:

Select Case y Case 1 To 12 GoTo a3 Case Else MsgBox "你所输入的月份不合法,请重新输入!" GoTo a1 End Select

a3:

If y < 12 Then Label1.Caption = Str(x) + "年" + Str((y)) + "月的月历为:" z = DateDiff("d", Str(x) + "-" & Str(y) + "-1", Str(x) + "-" + Str(y + 1) & "-1") Else Label1.Caption = x + "年" + y + "月的月历为:" z = DateDiff("d", Str(x) + "-" & Str(y) + "-1", Str(x + 1) + "-" + Str((y + 1) Mod 12) & "-1") End If CurrentY = 250 Print "SUN", "MOD", "TUE", "WED", "THU", "FRI", "SAT" a = Weekday(Str(x) + "-" + Str(y) + "-1")

Select Case a

Case 1 For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 2 t = 1 Print , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 3 t = 2 Print , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 4 t = 3 Print , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 5 t = 4 Print , , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 6 t = 5 Print , , , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 7 t = 6 Print , , , , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If

Next

End Select a1: End Sub

附图:

时间是100---9999年之间!谢谢采纳!

迗迗想伱的回答：

代码如下:

Private Sub Command1_Click() Cls x = Text1.Text y = Text2.Text If Text1 = "" Or Text2 = "" Then Text1.SetFocus MsgBox "请输入完整数据!" GoTo a1 End If

Select Case x Case 100 To 9999 GoTo a2 Case Else MsgBox "你所输入的年份不合法,请重新输入!" GoTo a1 End Select

a2:

Select Case y Case 1 To 12 GoTo a3 Case Else MsgBox "你所输入的月份不合法,请重新输入!" GoTo a1 End Select

a3:

If y < 12 Then Label1.Caption = Str(x) + "年" + Str((y)) + "月的月历为:" z = DateDiff("d", Str(x) + "-" & Str(y) + "-1", Str(x) + "-" + Str(y + 1) & "-1") Else Label1.Caption = x + "年" + y + "月的月历为:" z = DateDiff("d", Str(x) + "-" & Str(y) + "-1", Str(x + 1) + "-" + Str((y + 1) Mod 12) & "-1") End If CurrentY = 250 Print "SUN", "MOD", "TUE", "WED", "THU", "FRI", "SAT" a = Weekday(Str(x) + "-" + Str(y) + "-1")

Select Case a

Case 1 For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 2 t = 1 Print , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 3 t = 2 Print , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 4 t = 3 Print , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 5 t = 4 Print , , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 6 t = 5 Print , , , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If Next

Case 7 t = 6 Print , , , , , , For i = 1 To z t = t + 1 If Day(Now) = i Then ForeColor = vbRed Print i, Else ForeColor = vbBlack Print i, End If If t Mod 7 = 0 Then Print End If

Next

End Select a1: End Sub

附图:

时间是100---9999年之间!谢谢采纳!