Trang 1 trên 1

Mã nguồn lịch ÂD 2016 đơn giản

Đã gửi: T.Bảy 30/01/2016 8:49 pm
gửi bởi truongphu
  1. ' Coded by truongphu
  2. Dim NgàyAL As Integer, TênNgàyAL As String, ThángAL As Integer, TênThángAL As String, Nam As Integer, TênNaM As String, Nh As String
  3.  
  4. Private Function ToAL(data As Date)
  5.     Dim Can() As String, Chi() As String, TêTDL As Date
  6.         Can = Split("Canh,Tân,Nhâm,Qúy,Giáp,Ât,Bính,Ðinh,Mâu,Ky", ",")
  7.         Chi = Split("Thân,Dâu,Tuâ't,Ho'i,Tý,Su'u,Dâ`n,Mão,Thìn,Ty,Ngo,Mùi", ",")
  8.        
  9.     ''' Phâ`n cung câ'p du liêu: (2016 Ðã cung câp)
  10.    Dim DuLieu() As String, i As Byte, DaysAL As Byte
  11.     TêTDL = #1/1/2016#  ' <-- Cung câ'p sô' liêu
  12.    DuLieu = Split("13,1,0,1,0,1,0,0,1,0,1,1,0,1", ",") ' <-- Cung câ'p sô' liêu
  13.    ' Nam AL không nhuân ghi sô' 13, nhuân ghi tháng nhuân. 1 là tháng Ðu, 0 là tháng thiêu.
  14.    NgàyAL = DateDiff("d", TêTDL, data) + 22 ' Cong thêm ngày AL vào ngày 1/1/2016  ' <-- Cung câ'p sô' liêu
  15.    ThángAL = 11 ' Ghi tháng AL vào ngày 1/1/2016  ' <-- Cung câ'p sô' liêu
  16.    
  17.     ''' Bat Ðâu tính toán:
  18.    For i = 1 To 13
  19.         DaysAL = 29 + CByte(DuLieu(i))
  20.        
  21.         If NgàyAL > DaysAL Then
  22.             NgàyAL = NgàyAL - DaysAL
  23.             If i = DuLieu(0) + 1 Then ' Chi dùng cho tháng nhuân
  24.                ThángAL = ThángAL ' Chi dùng cho tháng nhuân
  25.                Nh = " (Nh)" ' Chi dùng cho tháng nhuân
  26.            Else
  27.                 ThángAL = ThángAL + 1
  28.             End If
  29.            
  30.             If ThángAL > 12 Then ThángAL = ThángAL - 12
  31.        
  32.         Else
  33.             Exit For
  34.         End If
  35.     Next
  36.    
  37.     'TênNgàyAL = Can(DateDiff("d", #4/1/1800#, data) Mod 10) & " " & Chi(DateDiff("d", #4/1/1800#, data) Mod 12)
  38.    'TênThángAL = Can((Nam * 12 + ThángAL + 7) Mod 10) & " " & Chi((ThángAL + 5) Mod 12)
  39.  
  40.     If ((ThángAL = 11) Or (ThángAL = 12)) And (data < TêTDL + 60) Then ' Ðiê'u chinh tháng 11, 12 Ðâ'u nam DL
  41.        Nam = Year(TêTDL) - 1
  42.     Else
  43.         Nam = Year(TêTDL)
  44.     End If
  45.     TênNaM = Can(Nam Mod 10) & " " & Chi(Nam Mod 12)
  46.    
  47. End Function
  48.  
  49. Private Sub Command1_Click()
  50.      ToAL #12/31/2016#
  51.     MsgBox NgàyAL & "/" & ThángAL & "/" & TênNaM
  52. End Sub
  53.  
  54.  


Hay không? :D