《VBA日期转换星座》 使用说明: 本程序可在各种支持VBA语言的软件上直接使用,其中MS Excel和MS Access已成功测试。(把程序复制到VBA编程器里即可直接使用) 程序使用方法如下图: 程序: Function XingZuo(MyDate As Date) '日期转换星座 On Error Resume Next Dim strConstellation As Variant strConstellation = Array("水瓶座", "双鱼座", "白羊座", "金牛座", "双子座", "巨蟹座", "狮子座", "处女座", "天枰座", "天蝎座", "射手座", "摩羯座") '水瓶座 1月20日~2月18日 '双鱼座 2月19日~3月20日 '白羊座 3月21日~4月19日 '金牛座 4月20日~5月20日 '双子座 5月21日~6月21日 '巨蟹座 6月22日~7月22日 '狮子座 7月23日~8月22日 '处女座 8月23日~9月22日 '天枰座 9月23日~10月22日 '天蝎座 10月23日~11月21日 '射手座 11月22日~12月21日 '摩羯座 12月22日~1月19日 If IsNull(MyDate) Or MyDate = 0 Then XingZuo = "" ElseIf CDate("01/20/" & Year(MyDate)) <= MyDate And MyDate <= CDate("02/18/" & Year(MyDate)) Then XingZuo = strConstellation(0) ElseIf CDate("02/19/" & Year(MyDate)) <= MyDate And MyDate <= CDate("03/20/" & Year(MyDate)) Then 第-1-页 / 共-2-页 XingZuo = strConstellation(1) ElseIf CDate("03/21/" & Year(MyDate)) <= MyDate And MyDate <= CDate("04/19/" & Year(MyDate)) Then XingZuo = strConstellation(2) ElseIf CDate("04/20/" & Year(MyDate)) <= MyDate And MyDate <= CDate("05/20/" & Year(MyDate)) Then XingZuo = strConstellation(3) ElseIf CDate("05/21/" & Year(MyDate)) <= MyDate And MyDate <= CDate("06/21/" & Year(MyDate)) Then XingZuo = strConstellation(4) ElseIf CDate("06/22/" & Year(MyDate)) <= MyDate And MyDate <= CDate("07/22/" & Year(MyDate)) Then XingZuo = strConstellation(5) ElseIf CDate("07/23/" & Year(MyDate)) <= MyDate And MyDate <= CDate("08/22/" & Year(MyDate)) Then XingZuo = strConstellation(6) ElseIf CDate("08/23/" & Year(MyDate)) <= MyDate And MyDate <= CDate("09/22/" & Year(MyDate)) Then XingZuo = strConstellation(7) ElseIf CDate("09/23/" & Year(MyDate)) <= MyDate And MyDate <= CDate("10/22/" & Year(MyDate)) Then XingZuo = strConstellation(8) ElseIf CDate("10/23/" & Year(MyDate)) <= MyDate And MyDate <= CDate("11/21/" & Year(MyDate)) Then XingZuo = strConstellation(9) ElseIf CDate("11/22/" & Year(MyDate)) <= MyDate And MyDate <= CDate("12/21/" & Year(MyDate)) Then XingZuo = strConstellation(10) ElseIf CDate("12/22/" & Year(MyDate)) <= MyDate Or (MyDate >= CDate("01/1/" & Year(MyDate)) And MyDate <= CDate("01/19/" & Year(MyDate))) Then XingZuo = strConstellation(11) End If End Function 第-2-页 / 共-2-页 本文来源:https://www.wddqw.com/doc/26a402d6195f312b3169a5bc.html