VB的文本资料,需要时有帮助

       Else
          If y <= 1910 Then
             tempStr = "清朝宣统"
             If y = 1909 Then
                tempStr = tempStr & "元年"
             Else
                tempStr = tempStr & UpNumber(CStr(y - 1909 + 1)) & "年"
             End If
          Else
             If y < 1949 Then
                tempStr = "中华民国"
                If y = 1912 Then
                   tempStr = tempStr & "元年"
                Else
                   tempStr = tempStr & UpNumber(CStr(y - 1912 + 1)) & "年"
                End If
             Else
                tempStr = "中华人民共和国成立"
                If y = 1949 Then
                   tempStr = tempStr & "了"
                Else
                   Select Case y
                      Case 2000
                         tempStr = "千禧年"
                      Case Else
                         tempStr = tempStr & UpNumber(CStr(y - 1949)) & "周年"
                   End Select
                End If
             End If
          End If
       End If
   End If
   
   Era = tempStr
End Function

' 传入 num 传回干支, 0=甲子
Public Function GanZhi(num As Long) As String
    Dim tempStr As String
    Dim i As Long
    i = (num - 1864) Mod 60 '计算干支
    tempStr = Gan(i Mod 10) & Zhi(i Mod 12)
    GanZhi = tempStr
End Function

'计算年的属相字串
Public Function YearAttribute(y As Long) As String
    YearAttribute = Animals((y - 1900) Mod 12)
End Function

'将数字汉化
Public Function UpNumber(Dxs As String) As String

 '检测为空时
 If Trim(Dxs) = "" Then
    UpNumber = ""
    Exit Function
 End If
  
 Dim Sw As Integer, SzUp As Integer, tempStr As String, DXStr As String
    Sw = Len(Trim(Dxs))
     
     Dim i As Integer
     For i = 1 To Sw
         tempStr = Right(Trim(Dxs), i)
         tempStr = Left(tempStr, 1)
         tempStr = Converts(tempStr)
         Select Case i
           Case 1
               If tempStr = "零" Then
                  tempStr = ""
                   Else
                  tempStr = tempStr + ""
               End If
           Case 2
               If tempStr = "零" Then
                  tempStr = "零"
                Else
                  tempStr = tempStr + "十"
               End If
           Case 3
               If tempStr = "零" Then
                  tempStr = "零"
                   Else
                  tempStr = tempStr + "百"
               End If
            Case 4
               If tempStr = "零" Then
                  tempStr = "零"
                   Else
                  tempStr = tempStr + "千"
               End If
            Case 5
               If tempStr = "零" Then
                  tempStr = "万"
                   Else
                  tempStr = tempStr + "万"
               End If
            Case 6
               If tempStr = "零" Then
                  tempStr = "零"
                   Else
                  tempStr = tempStr + "十"
               End If
            Case 7
               If tempStr = "零" Then
                  tempStr = "零"
                   Else
                  tempStr = tempStr + "百"
               End If
            Case 8
               If tempStr = "零" Then
                  tempStr = "零"
                   Else
                  tempStr = tempStr + "千"
               End If
            Case 9
               If tempStr = "零" Then
                  tempStr = "亿"
                   Else
                  tempStr = tempStr + "亿"
               End If
         End Select
    Dim TempA As String
        TempA = Left(Trim(DXStr), 1)
    If tempStr = "零" Then
      Select Case TempA
       Case "零"
            DXStr = DXStr
       Case "万"
            DXStr = DXStr
       Case "亿"
            DXStr = DXStr
       Case Else
            DXStr = tempStr + DXStr
      End Select
      Else
       DXStr = tempStr + DXStr
    End If
     Next
  
    UpNumber = DXStr
End Function
Private Function Converts(NumStr As String) As String
    Select Case val(NumStr)
      Case 0
        Converts = "零"
      Case 1
        Converts = "一"
      Case 2
        Converts = "二"
      Case 3
        Converts = "三"
      Case 4
        Converts = "四"
      Case 5
        Converts = "五"
      Case 6
         Converts = "六"
      Case 7
         Converts = "七"
      Case 8
         Converts = "八"
      Case 9
         Converts = "九"
    End Select
End Function
'中文日期
Public Function CDayStr(d As Long) As String
   Dim s As String
   Select Case d
      Case 0
        s = ""
      Case 10
        s = "初十"
      Case 20
        s = "二十"
      Case 30
        s = "三十"
      Case Else
        s = nStr2(d \ 10)  '整数除法
        s = s & nStr1(d Mod 10)
   End Select
   CDayStr = s
End Function
'计算星座归属
Public Function Constellation(m As Long, d As Long) As String
   Dim y As Long
   Dim tempDate As Date
   Dim ConstellName As String
 
   y = 2000
   tempDate = m & "/" & d & "/" & y

   Select Case tempDate
      Case #3/21/2003# To #4/19/2000#
            ConstellName = "白羊"
      Case #4/20/2000# To #5/20/2000#
            ConstellName = "金牛"
      Case #5/21/2000# To #6/21/2000#
            ConstellName = "双子"
      Case #6/22/2000# To #7/22/2000#
            ConstellName = "巨蟹"
      Case #7/23/2000# To #8/22/2000#
            ConstellName = "狮子"
      Case #8/23/2000# To #9/22/2000#
            ConstellName = "处女"
      Case #9/23/2000# To #10/23/2000#
            ConstellName = "天秤"
      Case #10/24/2000# To #11/21/2000#
            ConstellName = "天蝎"
      Case #11/22/2000# To #12/21/2000#
            ConstellName = "射手"
      Case #12/22/2000# To #12/31/2000#
            ConstellName = "摩蝎"
      Case #1/1/2000# To #1/19/2000#
            ConstellName = "摩蝎"
      Case #1/20/2000# To #2/18/2000#
            ConstellName = "水瓶"
      Case #2/19/2000# To #3/20/2000#
            ConstellName = "双鱼"
      Case Else
            ConstellName = ""
   End Select
   Constellation = ConstellName
End Function
'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'以下为类内部使用的一些函数
'传回农历 y年的总天数
Private Function lYearDays(ByVal y As Long) As Long
   
'   Dim i As Long
'   Dim f As Long
'   Dim sumDay As Long
'   Dim info As Long
   
'   sumDay = 348
'   i = &H8000
'   info = LunarInfo(y - 1900) And &H1000FFFF  '屏蔽高位,
'   Do
'     f = info And i
'     If f <> 0 Then
'       sumDay = sumDay + 1
'     End If
'     i = BitRight16(i, 1)
'   Loop Until i < &H10
'   lYearDays = sumDay + leapDays(y)
    
    lYearDays = LunarYearDays(y - 1900)  '先计算出每年的天数,并形成数组,以减少以后的运算时间
End Function

'传回农历 y年m月的总天数
Private Function lMonthDays(ByVal y As Long, ByVal m As Long) As Long
  If (LunarInfo(y - 1900) And &H1000FFFF) And BitRight32(&H10000, m) Then
     lMonthDays = 30
  Else
     lMonthDays = 29
  End If
End Function

'传回农历 y年闰月的天数
Private Function leapDays(y As Long) As Long
  If leapMonth(y) Then
    If LunarInfo(y - 1900) And &H10000 Then
      leapDays = 30
    Else
      leapDays = 29
    End If
  Else
    leapDays = 0
  End If
End Function

'传回农历 y年闰哪个月 1-12 , 没闰传回 0
Private Function leapMonth(y As Long) As Long
  Dim i As Long
  i = LunarInfo(y - 1900) And &HF
  If i > 12 Then
    Debug.Print y
  End If
  leapMonth = i
End Function

'计算公历年月的天数
Private Function SolarDays(y As Long, m As Long) As Long
   Dim d As Long
   
   If (y Mod 4) = 0 Then   '闰年
      If m = 2 Then
        d = 29
      Else
        d = SolarMonth(m - 1)
      End If
   Else
      If m = 2 Then
        d = 28
      Else
        d = SolarMonth(m - 1)
      End If
   End If
   
   SolarDays = d
End Function


'//////////////////////////////////////////////////////////////////////////////////////////////////
'
'主要的函数,用公历年月日对日期对象进行初使化,在此函数内部完成对私有对象属性的设置
'
'//////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub sInitDate(ByVal y As Long, ByVal m As Long, ByVal d As Long)
    Dim i As Long
    Dim leap As Long
    Dim Temp As Long
    Dim offset As Long
    
    mvarDate = m & "/" & d & "/" & y
    mvarsYear = y
    mvarsMonth = m
    mvarsDay = d
    
    '农历日期计算部分
    leap = 0
    Temp = 0
    
    offset = mvarDate - #1/30/1900#  '计算两天的基本差距
    
    For i = 1900 To 2049
        'temp = lYearDays(i)  '求当年农历年天数
        
        offset = offset - Temp
        If offset < 1 Then Exit For
    Next
    
    offset = offset + Temp
    mvarlYear = i
    
    leap = leapMonth(i) '闰哪个月
    mvarIsLeap = False
    For i = 1 To 12
        '闰月
        If leap > 0 And i = (leap + 1) And mvarIsLeap = False Then
           mvarIsLeap = True
           i = i - 1
           Temp = leapDays(mvarlYear)   '计算闰月天数
        Else
           Temp = lMonthDays(mvarlYear, i) '计算非闰月天数
         End If
    
        offset = offset - Temp
        If offset <= 0 Then Exit For
    Next
    
    offset = offset + Temp
    mvarlMonth = i
    mvarlDay = offset
        
End Sub

'//////////////////////////////////////////////////////////////////////////////////////////////////
'
'主要的函数,用农历年月日对日期对象进行初使化,在此函数内部完成对私有对象属性的设置
'
'//////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub lInitDate(ByVal y As Long, ByVal m As Long, ByVal d As Long, Optional LeapFlag As Boolean = False)
    Dim i As Long
    Dim leap As Long
    Dim Temp As Long
    Dim offset As Long

    mvarlYear = y
    mvarlMonth = m
    mvarlDay = d
    
    offset = 0
    
    For i = 1900 To y - 1
       Temp = LunarYearDays(i - 1900) '求当年农历年天数
       offset = offset + Temp
    Next
    
    leap = leapMonth(y) '闰哪个月
    If m <> leap Then
       mvarIsLeap = False  '当前日期并非闰月
    Else
       mvarIsLeap = LeapFlag  '使用用户输入的是否闰月月份
    End If
    
    If (m < leap) Or (leap = 0) Then   '当闰月在当前日期后
        For i = 1 To m - 1
           Temp = lMonthDays(y, i) '计算非闰月天数
           offset = offset + Temp
        Next
    Else   '在闰月后
        If mvarIsLeap = False Then  '用户要计算非闰月的月份
             For i = 1 To m - 1
                Temp = lMonthDays(y, i) '计算非闰月天数
                offset = offset + Temp
             Next
             If m > leap Then
                Temp = leapDays(y)   '计算闰月天数
                offset = offset + Temp
             End If
             
        Else  '此时只有mvarisleap=ture,
               For i = 1 To m
                 Temp = lMonthDays(y, i) '计算非闰月天数
                 offset = offset + Temp
               Next
        End If
    End If
    
    offset = offset + d '加上当月的天数
    mvarDate = DateAdd("d", offset, #1/30/1900#)
    mvarsYear = Year(mvarDate)
    mvarsMonth = Month(mvarDate)
    mvarsDay = Day(mvarDate)

End Sub

'本模块用于打印出1900-2049年 每年农历的天数,可以用于数组初使化
'Public Sub printf()
'    Dim i As Long, j As Long
'    Dim temp(10) As Long
'    Dim base As Long
    
'    base = 1900
'    For i = 1 To 15
'       For j = 1 To 10
'         temp(j - 1) = lYearDays((i - 1) * 10 + (j - 1) + base) '求当年农历年天数
'       Next
'       Debug.Print CStr(temp(0)) & " , " & CStr(temp(1)) & " , " & CStr(temp(2)) & " , " & CStr(temp(3)) & " , " & CStr(temp(4)) & " , " & CStr(temp(5)) & " , " & CStr(temp(6)) & " , " & CStr(temp(7)) & " , " & CStr(temp(8)) & " , " & CStr(temp(9)) & " , " & " _ "
'    Next
'End Sub