vb獲取當天的公曆節日並顯示倒計時

我們可以用vb獲取當天是否有相關的公曆節日,如果沒有則進行最近的節日倒計時

工具/原料

VB環境、windows環境
vb編譯器

方法/步驟

輔助函數:獲取某月第幾個星期幾:

'判斷某月的第幾個星期幾,實例:getweek(2016,9,2,0),表示2016年9月的第二個星期日的日期是多少

Function getweek(year As Integer, yue As Integer, num As Integer, week As Integer) As String

Dim day As String '月份的天數

For I = 1 To 7

If Weekday(year & "-" & yue & "-" & I) - 1 = week Then

day = I '第1個星期幾的日期

End If

Next I

For I = 1 To num - 1

day = day + 7 '第num個星期幾的日期

Next I

'修正,防止出現如32號的錯誤信息

Select Case yue

Case 1, 3, 5, 7, 8, 10, 12 '31天的月數

If day > 31 Then

getweek = ""

Else

getweek = Format(year & "-" & yue & "-" & day, "yyyy-mm-dd")

End If

Case 4, 6, 9, 11 '30天的月數

If day > 30 Then

getweek = ""

Else

getweek = Format(year & "-" & yue & "-" & day, "yyyy-mm-dd")

End If

Case 2 '平閏月

Dim temp As Integer

temp = 28

If year Mod 100 = 0 And year Mod 400 = 0 Then

temp = 29

End If

If year Mod 100 <> 0 And year Mod 4 = 0 Then

temp = 29

End If

If day > temp Then

getweek = ""

Else

getweek = Format(year & "-" & yue & "-" & day, "yyyy-mm-dd")

End If

End Select

End Function

主要函數:

'應用:xqjr(2016,10,1,"1")

Function xqjr(myyear As Integer, month As Integer, day As Integer, myms As String) As String

'myms:0表示返回節日或者空;1表示返回節日或者距離節日多少天

Dim riqi As String

Dim tempriqi(9 To 2000) As String, s As String, j As Integer

j = 9

riqi = Format(myyear & "-" & month & "-" & day, "yyyy-mm-dd")

Dim tsjr(1 To 500) As String '節日日期

Dim jierimc(1 To 500) As String '節日名稱

'以下為特殊節日,某月的第幾個星期幾的節日

tsjr(1) = getweek(myyear, 11, 4, 4) '感恩節

tsjr(2) = getweek(myyear, 5, 2, 0) '母親節

tsjr(3) = getweek(myyear, 6, 3, 0) '父親節

tsjr(4) = getweek(myyear, 9, 3, 2) '國際和平日

tsjr(5) = getweek(myyear, 9, 4, 0) '國際聾人節

tsjr(6) = getweek(myyear, 5, 3, 0) '全國助殘節

tsjr(7) = getweek(myyear, 9, 3, 6) '全國國防教育日

tsjr(8) = getweek(myyear, 10, 2, 3) '國際減輕自然災害

jrmc = Array("感恩節", "母親節", "父親節", "國際和平日", "國際聾人節", "全國助殘節", "全國國防教育日", "國際減輕自然災害")

For I = 1 To 8 '將特殊節日名稱正規化

jierimc(I) = jrmc(I - 1)

Next I

If Dir(App.Path & "/festival.txt") <> "" Then '加載文件中更多節日信息

Open App.Path & "/festival.txt" For Input As #1

Do While Not EOF(1)

Line Input #1, s

If s <> "" And Left(s, 1) = "&" Then

tempriqi(j) = Right(s, Len(s) - 1)

j = j + 1

End If

Loop

Close #1

Dim tempyue As String, tempri As String, tempjieri As String '解讀節日數據信息

Dim t(1 To 3) As Integer

For I = 9 To j

If InStr(tempriqi(I), "月") <> 0 And InStr(tempriqi(I), "日") <> 0 And InStr(tempriqi(I), "-") <> 0 Then

t(1) = InStr(tempriqi(I), "月")

t(2) = InStr(tempriqi(I), "日")

t(3) = InStr(tempriqi(I), "-")

tempyue = Left(tempriqi(I), t(1) - 1)

tempri = Mid(tempriqi(I), t(1) + 1, t(2) - t(1) - 1)

tempjieri = Right(tempriqi(I), Len(tempriqi(I)) - t(3))

tsjr(I) = Format(myyear & "-" & tempyue & "-" & tempri, "yyyy-mm-dd")

jierimc(I) = tempjieri

End If

Next I

End If

'完成加載所有節日信息

'此時注釋:tsjr(1 to 500) 為節日日期;jierimc(1 To 500) 為對應節日名稱

Select Case myms

Case "0" '模式0,表示結果只返回節日或者空

xqjr = ""

For I = 1 To j

If riqi = tsjr(I) Then

xqjr = jierimc(I)

Exit Function

End If

Next I

Case "1" '模式1,表示提示距離最近的節日有多少天

Dim min As Integer, myday As Integer

Dim sjc(1 To 500) As Integer

For I = 1 To j - 1                 '計算所有節日的時間差

If DateDiff("d", riqi, tsjr(I)) >= 0 Then

sjc(I) = DateDiff("d", riqi, tsjr(I))

Else

sjc(I) = 365

End If

Next I

min = sjc(1)

For I = 1 To j - 1              '找出最小時間差的節日

If min >= sjc(I) Then

min = sjc(I)

myday = I

End If

Next I

Select Case min      '時間差(天數)判斷

Case 0

xqjr = "今天是" & jierimc(myday)

Case 1

xqjr = "明天為" & jierimc(myday)

Case 2

xqjr = "後天為" & jierimc(myday)

Case Else

xqjr = "距離" & jierimc(myday) & "還有" & min & "天"

End Select

End Select

End Function

一.上述函數沒有任何文件的前提下,只能顯示八個特殊的節日,如感恩節、父親節等

二.如果需要添加更多的節日,請在程序目錄添加festival.txt文件,裡面存放更多的節日信息

格式如:&1月1日-元旦

三.附錄節日信息:

&1月1日-元旦

&2月2日-世界濕地日

&2月14日-情人節

&3月3日-全國愛耳日

&3月5日-青年志願者服務日

&3月8日-國際婦女節

&3月9日-保護母親河日

&3月12日-中國植樹節

&3月14日-白色情人節

&3月14日-國際警察日

&3月15日-世界消費者權益日

&3月21日-世界森林日

&3月22日-世界水日

&3月23日-世界氣象日

&3月24日-世界防治結核病日

&4月1日-愚人節

&4月5日-清明節

&4月7日-世界衛生日

&4月22日-世界地球日

&4月26日-世界智慧財產權日

&5月1日-國際勞動節

&5月3日-世界哮喘日

&5月4日-中國青年節

&5月8日-世界紅十字日

&5月12日-國際護士節

&5月15日-國際家庭日

&5月17日-世界電信日

&5月20日-全國學生營養日

&5月23日-國際牛奶日

&5月31日-世界無菸日

&6月1日-國際兒童節

&6月5日-世界環境日

&6月6日-全國愛眼日

&6月17日-世界防治荒漠化和乾旱日

&6月23日-國際奧林匹克日

&6月25日-全國土地日

&6月26日-國際禁毒日

&7月1日-中國共產黨誕生日

&7月7日-中國人民抗日戰爭紀念日

&7月11日-世界人口日

&8月1日-中國人民解放軍建軍節

&8月12日-國際青年節

&9月8日-國際掃盲日

&9月10日-中國教師節

&9月16日-中國腦健康日

&9月20日-全國愛牙日

&9月21日-世界停火日

&9月27日-世界旅遊日

&10月1日-國慶節

&10月4日-世界動物日

&10月5日-世界教師日

&10月8日-全國高血壓日

&10月9日-世界郵政日

&10月10日-世界精神衛生日

&10月14日-世界標準日

&10月15日-國際盲人節

&10月16日-世界糧食日

&10月17日-國際消除貧困日

&10月24日-世界發展新聞日

&10月28日-中國男性健康日

&10月29日-國際生物多樣性日

&10月31日-萬聖節

&11月8日-中國記者節

&11月9日-消防宣傳日

&11月14日-世界糖尿病日

&11月17日-國際大學生節

&11月25日-國際消除對婦女的暴力日

&12月1日-世界愛滋病日

&12月3日-世界殘疾人日

&12月4日-全國法制宣傳日

&12月9日-世界足球日

&12月24日-平安夜

&12月25日-聖誕節

&12月29日-國際生物多樣性日

注意事項

關於調用1:舉例:Text.Text=xqjr(2016,3,1,"1"),則顯示「舉例婦女節還有7天」
關於調用2:舉例:Text.Text=xqjr(2016,3,1,"0"),則顯示空白信息

本文內容整理自網絡, 文中所有觀點看法不代表淘大白的立場