CHUSHIHUA: 

  AddMonth = Val(Mid(daList(AddYear), 15, 2)) 

  AddDay = Val(Mid(daList(AddYear), 17, 2)) 

  conDate = DateSerial(AddYear, AddMonth, AddDay) 

  setDate = DateSerial(tYear, tMonth, tDay) 

  getDay = DateDiff("d", conDate, setDate) 

  If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA 

  '''' addday = NearDay 

  AddDay = 1: AddMonth = 1 

  For i = 1 To getDay 

    AddDay = AddDay + 1 

    If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then 

      If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then 

        RunYue = True 

      Else 

        RunYue = False 

        AddMonth = AddMonth + 1 

      End If 

      AddDay = 1 

    End If 

  Next 

  md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十" 

  dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2) 

  mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月" 

  YouGetDate = DateSerial(AddYear, AddMonth, AddDay) 

  tiangan$ = "甲乙丙丁戊已庚辛壬癸" 

  dizhi$ = "子丑寅卯辰巳午未申酉戌亥" 

  Dim ganzhi(0 To 59) As String * 2 

  For i = 0 To 59 

   ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1) 

  ''''ff$ = ff$ + ganzhi(i) 

  Next i 

  ''''MsgBox ff$, , Len(ff$) 

  YLyear = ganzhi((AddYear - 4) Mod 60) 

  shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪" 

  YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1) 

  If RunYue Then mm$ = "闰" + mm$ 

  GetYLDate = mm$ + dd$ 

End Function 

''''下面是一个使用的例子，你需要在窗体上加上一个按扭，并命名为Command1，然后将下列代码复制到窗体的代码中 

Private Sub Command1_Click() 

  Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String 

  ''''取公历1999年10月28日的农历日期 

  ty = 1999 

  tm = 10 

  td = 28 

  t = GetYLDate(ty, tm, td, yl, sx) 

  MsgBox t 

  MsgBox ty & "-" & tm & "-" & td & " " & yl & " " & sx 

  ''''取1999年农历十月28的公历日期 

  t = GetYLDate(ty, tm, td, yl, sx, True) 

  MsgBox t 

  MsgBox ty & "-" & tm & "-" & td & " " & yl & " " & sx 

End Sub

上一页  [1] [2] [3]