|
网上找的程序,不知什么原因只能提前预告节气,而当天不显示
Private Function JieQi(TempDate As String) As String '计算节气
Dim S_Term(1 To 24) As String
Dim StInfo(1 To 24) As Long
Dim y As Integer, j As Integer, k As Integer
Dim E(1) As Double
Dim dtJ As Date
Dim strJm As String, strJd As String
Dim Strj As String '节气日期 '节气名
S_Term(1) = "小寒"
S_Term(2) = "大寒"
S_Term(3) = "立春"
S_Term(4) = "雨水"
S_Term(5) = "惊蛰"
S_Term(6) = "春分"
S_Term(7) = "清明"
S_Term(8) = "谷雨"
S_Term(9) = "立夏"
S_Term(10) = "小满"
S_Term(11) = "芒种"
S_Term(12) = "夏至"
S_Term(13) = "小暑"
S_Term(14) = "大署"
S_Term(15) = "立秋"
S_Term(16) = "处暑"
S_Term(17) = "白露"
S_Term(18) = "秋分"
S_Term(19) = "寒露"
S_Term(20) = "霜降"
S_Term(21) = "立冬"
S_Term(22) = "小雪"
S_Term(23) = "大雪"
S_Term(24) = "冬至" '节气信息
StInfo(1) = 0
StInfo(2) = 21208
StInfo(3) = 42467
StInfo(4) = 63836
StInfo(5) = 85337
StInfo(6) = 107014
StInfo(7) = 128867
StInfo(8) = 150921
StInfo(9) = 173149
StInfo(10) = 195551
StInfo(11) = 218072
StInfo(12) = 240693
StInfo(13) = 263343
StInfo(14) = 285989
StInfo(15) = 308563
StInfo(16) = 331033
StInfo(17) = 353350
StInfo(18) = 375494
StInfo(19) = 397447
StInfo(20) = 419210
StInfo(21) = 440795
StInfo(22) = 462224
StInfo(23) = 483532
StInfo(24) = 504758
y = Val(Left(TempDate, 4)): j = Val(Mid(TempDate, 6, 2)): k = Val(Right(TempDate, 2))
If k <= 15 Then
j = j * 2 - 1
Else
j = j * 2
End If
E(0) = (31556925.9747 * (y - 1900) + StInfo(j) * 60#)
E(1) = DateDiff("s", "1970-1-1 0:0", "1900-1-6 2:5") + E(0)
E(0) = E(1) / 2
dtJ = DateAdd("s", E(1) - E(0), DateAdd("s", E(0), "1970-1-1 1:18"))
dtJ = Year(dtJ) & "-" & Month(dtJ) & "-" & Day(dtJ)
If (Month(dtJ) < 10) Then
strJm = "0" & Month(dtJ)
Else
strJm = Month(dtJ)
End If
If (Day(dtJ) < 10) Then
strJd = "0" & Day(dtJ)
Else
strJd = Day(dtJ)
End If
Strj = Format(Year(dtJ) & "-" & strJm & "-" & strJd, "yyyy-mm-dd")
JieQi = ""
If DateDiff("d", Strj, TempDate) = -2 Then JieQi = "后天" + S_Term(j)
If DateDiff("d", Strj, TempDate) = -1 Then JieQi = "明天" + S_Term(j)
If Strj = TempDate Then JieQi = "今天" + S_Term(j)
End Function
Sub 二十四节气()
MsgBox JieQi(Date)
End Sub
|
|