利用 wordXP 实现自动排班

'传回农历 y年闰月的天数
Private Function LeapDays(ByVal Y As Integer) As Integer
    Dim m As Integer
    Dim l As Double
    m = LeapMonth(Y)
    If m = 0 Then
        LeapDays = 0
    Else
        l = LunarInfo(Y - 1900)
        'l = LunarInfo(Y - 1900 + 1)
        If l < 0 Then l = l * (-1)
        l = (l And &H10000)
            If l = 0 Then
                LeapDays = 29
            Else
                LeapDays = 30
            End If
    End If
End Function

'传回农历 y年闰哪个月 1-12 , 没闰传回 0 OK

Private Function LeapMonth(ByVal Y As Integer) As Integer
    LeapMonth = 0
    If Y >= 1900 Then LeapMonth = (LunarInfo(Y - 1900) And &HF)
End Function

'传回农历 y年m月的总天数 OK-

Private Function lMonthDays(ByVal Y As Integer, ByVal m As Integer) As Integer
    If Y < 1900 Then Y = 1900
    If (LunarInfo(Y - 1900) And Int(&H10000 / (2 ^ m))) = 0 Then
    'If (LunarInfo(Y - 1900 + 1) And Int(&H10000 / (2 ^ m))) = 0 Then
        lMonthDays = 29
    Else
        lMonthDays = 30
    End If
End Function

'根据给定的阳历，返回农历的日期

Private Function GetLunar(ByVal SolarDate As Date) As String
    Dim DaysOffset As Long
    Dim i As Integer
    Dim Temp As Long
    Dim lyear, lmonth, lday As Integer
    DaysOffset = SolarDate - CDate("1900-1-31")
    i = 1900
    Do While i < 2050 And DaysOffset >= 0

上一页 [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12] [13] [14] 下一页

复制本页网址和标题，发送给你QQ/Msn的好友一起分享

上一篇:青少年培养与网络文化漫谈（下篇）

下一篇:电脑使用者的眼睛保护须知