• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Đổi ngày dương lịch sang ngày âm lịch

• Trang chủ

  • Thủ Thuật Access
  • Access Cơ Bản
  • Forms
  • Đổi ngày dương lịch sang ngày âm lịch
• Đổi ngày dương lịch sang ngày âm lịch

• Đổi ngày dương lịch sang ngày âm lịch

  dcongphuc > 25-03-12, 12:18 PM

  Xin chào các bác.
  Tôi có file Excell đổi ngày dương lịch sang ngày âm lịch, bây giờ tôi muốn đem code của file này sang chương trình Access để sử dụng cụ thể là:tạo một form trong Access, trên form đó có có 4 textbox.Một cái textbox dùng để gỏ vào ngày dương lịch và những textbox còn lại dùng để chuyển sang ngày âm lịch giống như trong file Excell này vậy, nhưng tôi không biết cách gán code vào các textbox.
  Tôi có gởi 1 file Excell mẫu và 1file Access đã chép code vào và đã tạo form sẳn trong đó, bác nào biết thì giúp giùm tôi nhé, tôi cám ơn nhiều lắm. Link tải file: http://www.mediafire.com/?sp4qd60qg6okdrf

• RE: Đổi ngày dương lịch sang ngày âm lịch

  Noname > 25-03-12, 01:25 PM

  Cảm ơn Bạn vì đoạn code rất hay, rất có giá trị tham khảo cho việc xếp lịch nghỉ.
  
  Trong Access, để khai báo các biến/ hàm là public thì nó phải được khai báo trong một module chứ không thể trong form. Vì vậy, bạn phải tạo 1 module mới copy toàn bộ nội dung của mình vào
  
  

  Mã:

  Option Compare Database


Public Lday, Lmonth As Byte, Lyear As Integer, isLeap, LunarInfo
Sub LNI()
LunarInfo = Array( _
&H3C4BD8, &H624AE0, &H4CA570, &H3854D5, &H5CD260, &H44D950, &H315554, &H5656A0, &H409AD0, &H2A55D2, &H504AE0, &H3AA5B6, &H60A4D0, &H48D250, &H33D255, &H58B540, &H42D6A0, &H2CADA2, &H5295B0, &H3F4977, _
&H644970, &H4CA4B0, &H36B4B5, &H5C6A50, &H466D40, &H2FAB54, &H562B60, &H409570, &H2C52F2, &H504970, &H3A6566, &H5ED4A0, &H48EA50, &H336A95, &H585AD0, &H442B60, &H2F86E3, &H5292E0, &H3DC8D7, &H62C950, _
&H4CD4A0, &H35D8A6, &H5AB550, &H4656A0, &H31A5B4, &H5625D0, &H4092D0, &H2AD2B2, &H50A950, &H38B557, &H5E6CA0, &H48B550, &H355355, &H584DA0, &H42A5B0, &H2F4573, &H5452B0, &H3CA9A8, &H60E950, &H4C6AA0, _
&H36AEA6, &H5AAB50, &H464B60, &H30AAE4, &H56A570, &H405260, &H28F263, &H4ED940, &H38DB47, &H5CD6A0, &H4896D0, &H344DD5, &H5A4AD0, &H42A4D0, &H2CD4B4, &H52B250, &H3CD558, &H60B540, &H4AB5A0, &H3755A6, _
&H5C95B0, &H4649B0, &H30A974, &H56A4B0, &H40AA50, &H29AA52, &H4E6D20, &H39AD47, &H5EAB60, &H489370, &H344AF5, &H5A4970, &H4464B0, &H2C74A3, &H50EA50, &H3D6A58, &H6256A0, &H4AAAD0, &H3696D5, &H5C92E0, _
&H46C960, &H2ED954, &H54D4A0, &H3EDA50, &H2A7552, &H4E56A0, &H38A7A7, &H5EA5D0, &H4A92B0, &H32AAB5, &H58A950, &H42B4A0, &H2CBAA4, &H50AD50, &H3C55D9, &H624BA0, &H4CA5B0, &H375176, &H5C5270, &H466930, _
&H307934, &H546AA0, &H3EAD50, &H2A5B52, &H504B60, &H38A6E6, &H5EA4E0, &H48D260, &H32EA65, &H56D520, &H40DAA0, &H2D56A3, &H5256D0, &H3C4AFB, &H6249D0, &H4CA4D0, &H37D0B6, &H5AB250, &H44B520, &H2EDD25, _
&H54B5A0, &H3E55D0, &H2A55B2, &H5049B0, &H3AA577, &H5EA4B0, &H48AA50, &H33B255, &H586D20, &H40AD60, &H2D4B63, &H525370, &H3E49E8, &H60C970, &H4C54B0, &H3768A6, &H5ADA50, &H445AA0, &H2FA6A4, &H54AAD0, _
&H4052E0, &H28D2E3, &H4EC950, &H38D557, &H5ED4A0, &H46D950, &H325D55, &H5856A0, &H42A6D0, &H2C55D4, &H5252B0, &H3CA9B8, &H62A930, &H4AB490, &H34B6A6, &H5AAD50, &H4655A0, &H2EAB64, &H54A570, &H4052B0, _
&H2AB173, &H4E6930, &H386B37, &H5E6AA0, &H48AD50, &H332AD5, &H582B60, &H42A570, &H2E52E4, &H50D160, &H3AE958, &H60D520, &H4ADA90, &H355AA6, &H5A56D0, &H462AE0, &H30A9D4, &H54A2D0, &H3ED150, &H28E952, _
&H4EB520, &H38D727, &H5EADA0, &H4A55B0, &H362DB5, &H5A45B0, &H44A2B0, &H2EB2B4, &H54A950, &H3CB559, &H626B20, &H4CAD50, &H385766, &H5C5370, &H484570, &H326574, &H5852B0, &H406950, &H2A7953, &H505AA0, _
&H3BAAA7, &H5EA6D0, &H4A4AE0, &H35A2E5, &H5AA550, &H42D2A0, &H2DE2A4, &H52D550, &H3E5ABB, &H6256A0, &H4C96D0, &H3949B6, &H5E4AB0, &H46A8D0, &H30D4B5, &H56B290, &H40B550, &H2A6D52, &H504DA0, &H3B9567, _
&H609570, &H4A49B0, &H34A975, &H5A64B0, &H446A90, &H2CBA94, &H526B50, &H3E2B60, &H28AB61, &H4C9570, &H384AE6, &H5CD160, &H46E4A0, &H2EED25, &H54DA90, &H405B50, &H2C36D3, &H502AE0, &H3A93D7, &H6092D0, _
&H4AC950, &H32D556, &H58B4A0, &H42B690, &H2E5D94, &H5255B0, &H3E25FA, &H6425B0, &H4E92B0, &H36AAB6, &H5C6950, &H4674A0, &H31B2A5, &H54AD50, &H4055A0, &H2AAB73, &H522570, &H3A5377, &H6052B0, &H4A6950, _
&H346D56, &H585AA0, &H42AB50, &H2E56D4, &H544AE0, &H3CA570, &H2864D2, &H4CD260, &H36EAA6, &H5AD550, &H465AA0, &H30ADA5, &H5695D0, &H404AD0, &H2AA9B3, &H50A4D0, &H3AD2B7, &H5EB250, &H48B540, &H33D556) '' /* Years 2100-2199 */
End Sub

Sub lunar(d, m, y)
Dim DiffADate, Counter, I, Temp
DiffADate = DateDiff("d", #1/31/1900#, CDate(d & "-" & m & "-" & y))
Counter = -1
Lyear = 1900
For I = Lyear To 2199
Temp = YearDays(I)
Counter = Counter + Temp
If Counter >= DiffADate Then
Counter = Counter - Temp
Exit For
End If
Lyear = Lyear + 1
Next
Leap = LeapMonth(Lyear)
isLeap = ""
Lmonth = 1
For I = 1 To 12
If Leap > 0 And I = Leap + 1 And isLeap = "" Then
isLeap = "(N)"
Lmonth = Lmonth - 1
I = I - 1
Temp = LeapDay(Lyear)
Else
Temp = MonthDays(Lyear, I)
End If
If isLeap = "(N)" And I <> Leap Then isLeap = ""
Counter = Counter + Temp
If Counter >= DiffADate Then
Counter = Counter - Temp
Exit For
End If
Lmonth = Lmonth + 1
Next
Lday = DiffADate - Counter
End Sub
Function LeapMonth(y)
LNI
If y >= 1900 Then LeapMonth = LunarInfo(y - 1900) And &HF Else LeapMonth = 0
End Function
'-----------
Function LeapDay(y)
LNI
If LunarInfo(y - 1900) And &HF Then
If LunarInfo(y - 1900) And &H10000 Then LeapDay = 30 Else LeapDay = 29
Else
LeapDay = 0
End If
End Function
'-----------
Function MonthDays(y, m)
LNI
MonthMask = Array(32768, 16384, 8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16)
If LunarInfo(y - 1900) And MonthMask(m - 1) Then MonthDays = 30 Else MonthDays = 29
End Function
'-----------
Function YearDays(y)
Dim I
LNI
MonthMask = Array(32768, 16384, 8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16)
YearDays = 348
For I = 0 To 11
If LunarInfo(y - 1900) And MonthMask(I) Then YearDays = YearDays + 1
Next
YearDays = YearDays + LeapDay(y)
End Function

'Ham so chuyen doi tu Duong lich sang Am lich dang ngay,thang,nam
Public Function TransLu1(d, m, y)
Call lunar(m, d, y)
TransLu1 = Lday & "/" & Lmonth & isLeap & "/" & Lyear
End Function

'Ham so chuyen doi tu Duong lich sang Am lich dang tu mot o
Public Function TransLu(d, m, y)
Call lunar(m, d, y)
TransLu = Lday & "-" & Lmonth & isLeap & "-" & CanchiV(Lyear - 0)
End Function

'Ngay thang nam am lich sang duong lich
Public Function TransSolar(d, m, y) As Date
Dim iSd As Date
iSd = DateSerial(y, m, d) - 70
Do
iSd = iSd + 1
Loop Until TransLu1(Day(iSd), Month(iSd), Year(iSd)) = d & "/" & m & "/" & y
TransSolar = iSd
End Function


Public Function CanchiV(stY As Long)
    Dim xx, yy, a, b
    xx = 1 + ((stY - 4) Mod 10)
    yy = 1 + ((stY - 4) Mod 12)

    'Tính Can
    Select Case xx
    Case 1: a = "At"
    Case 2: a = "Giap"
    Case 3: a = "Binh"
    Case 4: a = "Dinh"
    Case 5: a = "Mau"
    Case 6: a = "Ky"
    Case 7: a = "Canh"
    Case 8: a = "Tan"
    Case 9: a = "Nham"
    Case 10: a = "Quy"
    End Select

    'Tính Chi
    Select Case yy
    Case 1: b = "Ty"
    Case 2: b = "Suu"
    Case 3: b = "Dan"
    Case 4: b = "Mao"
    Case 5: b = "Thin"
    Case 6: b = "Ty"
    Case 7: b = "Ngo"
    Case 8: b = "Mui"
    Case 9: b = "Than"
    Case 10: b = "Dau"
    Case 11: b = "Tuat"
    Case 12: b = "Hoi"
    End Select
    CanchiV = a & " " & b
End Function

  
  Access phân biệt các ô qua các trường Name của đối tượng.Bạn có thể click chuột phải vào một đối tượng, chọn properties , tab other để xem trường name và đặt lại nó.
  
  Trong ví dụ của bạn, bạn có 4 ô lần lượt có name là text0,text2,text4,text6
  
  trong đó, text0 dùng để nhập ngày.
  Giá trị Control source text2, bạn nhập như sau:
  

  Mã:

  =TransLu(Day([text0]),Month([text0]),Year([text0]))

  
  Giá trị Control source text4 bạn nhập như sau
  

  Mã:

  =TransLu1(Day([text0]),Month([text0]),Year([text0]))

  Giá trị Control source text6 bạn nhập như sau:
  

  Mã:

  =TransSolar(Day([text4]),Month([text4]),Year([text4]))

  Bạn có thể tham khảo bài làm của mình
  Tải xuống

• RE: Đổi ngày dương lịch sang ngày âm lịch

  dcongphuc > 25-03-12, 03:25 PM

  Cảm ơn Bạn vì đã trả lời, có hướng dẫn và có file mẫu để tham khảo trong thời gian nhanh nhất.
  Một lần nữa cám ơn BẠN và chúc cho trang web ngày càng phát triển.
  Chào Bạn.

• RE: Đổi ngày dương lịch sang ngày âm lịch

  ledangvan > 26-03-12, 02:29 PM

  Bài viết của bác hay, tuy nhiên em thử có một số lỗi VD :Ngày 06/04/2012 không đổi được nó báo lỗi
  Hoặc ngày 09/04/2012 máy đơ luôn. Bác xem lại nhé
  

• RE: Đổi ngày dương lịch sang ngày âm lịch

  xuankien07 > 03-04-12, 10:09 PM

  Bạn Noname ơi cái code sai téc rồi nó đổi ngày có đúng tí nao đâu???

• RE: Đổi ngày dương lịch sang ngày âm lịch

  Noname > 03-04-12, 11:44 PM

  (03-04-12, 10:09 PM)xuankien07 Đã viết: Bạn Noname ơi cái code sai téc rồi nó đổi ngày có đúng tí nao đâu???

  
  Đính chính : Code không phải của mình mà là của chủ thớt! Mình chỉ giúp chủ thớt demo lại thôi!
  
  Nếu bạn có code hay hơn thì xin chia sẻ, nếu thấy không đúng thì xin cho ví dụ, demo của bạn.

• RE: Đổi ngày dương lịch sang ngày âm lịch

  xuankien07 > 05-04-12, 06:02 PM

  Public Lday, Lmonth, Lyear, isLeap, LunarInfo
  Sub lunar(d, m, y)
  Dim DiffADate, Counter, i, Temp
  DiffADate = DateDiff("d", #1/31/1900#, CDate(m & "-" & d & "-" & y))
  Counter = -1
  Lyear = 1900
  For i = Lyear To 2199
  Temp = YearDays(i)
  Counter = Counter + Temp
  If Counter >= DiffADate Then
  Counter = Counter - Temp
  Exit For
  End If
  Lyear = Lyear + 1
  Next
  
  Leap = LeapMonth(Lyear)
  isLeap = ""
  Lmonth = 1
  
  For i = 1 To 12
  If Leap > 0 And i = Leap + 1 And isLeap = "" Then
  isLeap = "(N)"
  Lmonth = Lmonth - 1
  i = i - 1
  Temp = LeapDay(Lyear)
  Else
  Temp = MonthDays(Lyear, i)
  End If
  
  If isLeap = "(N)" And i <> Leap Then isLeap = ""
  
  Counter = Counter + Temp
  
  If Counter >= DiffADate Then
  Counter = Counter - Temp
  Exit For
  End If
  Lmonth = Lmonth + 1
  Next
  Lday = DiffADate - Counter
  End Sub
  
  Function LeapMonth(y) ''''''''''''
  If y >= 1900 Then LeapMonth = LunarInfo(y - 1900) And &HF Else LeapMonth = 0
  End Function
  
  Function LeapDay(y)
  If LunarInfo(y - 1900) And &HF Then
  If LunarInfo(y - 1900) And &H10000 Then LeapDay = 30 Else LeapDay = 29
  Else
  LeapDay = 0
  End If
  End Function
  
  Function MonthDays(y, m) '''''''''''''''
  MonthMask = Array(32768, 16384, 8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16)
  If LunarInfo(y - 1900) And MonthMask(m - 1) Then MonthDays = 30 Else MonthDays = 29
  End Function
  
  Function YearDays(y) '''''''''''''
  Dim i
  MonthMask = Array(32768, 16384, 8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16)
  YearDays = 348
  For i = 0 To 11
  If LunarInfo(y - 1900) And MonthMask(i) Then YearDays = YearDays + 1
  Next
  YearDays = YearDays + LeapDay(y)
  End Function
  
  Public Function TransLu(d, m, y)
  Call lunar(m, d, y)
  TransLu = Lday & "/" & Lmonth & isLeap & "/" & Lyear
  End Function
  
  Public Function TransLu1(NT)
  Call lunar(Day(NT), Month(NT), Year(NT))
  End Function
  
  Public Function TransSolar(d, m, y)
  Dim iSd
  iSd = DateSerial(y, m, d) - 70
  Do
  iSd = iSd + 1
  Loop Until TransLu(Day(iSd), Month(iSd), Year(iSd)) = d & "/" & m & "/" & y
  TransSolar = iSd
  End Function
  
  Function licham(ngayduong)
  LunarInfo = Array( _
  &H3C4BD8, &H624AE0, &H4CA570, &H3854D5, &H5CD260, &H44D950, &H315554, &H5656A0, &H409AD0, &H2A55D2, &H504AE0, &H3AA5B6, &H60A4D0, &H48D250, &H33D255, &H58B540, &H42D6A0, &H2CADA2, &H5295B0, &H3F4977, _
  &H644970, &H4CA4B0, &H36B4B5, &H5C6A50, &H466D40, &H2FAB54, &H562B60, &H409570, &H2C52F2, &H504970, &H3A6566, &H5ED4A0, &H48EA50, &H336A95, &H585AD0, &H442B60, &H2F86E3, &H5292E0, &H3DC8D7, &H62C950, _
  &H4CD4A0, &H35D8A6, &H5AB550, &H4656A0, &H31A5B4, &H5625D0, &H4092D0, &H2AD2B2, &H50A950, &H38B557, &H5E6CA0, &H48B550, &H355355, &H584DA0, &H42A5B0, &H2F4573, &H5452B0, &H3CA9A8, &H60E950, &H4C6AA0, _
  &H36AEA6, &H5AAB50, &H464B60, &H30AAE4, &H56A570, &H405260, &H28F263, &H4ED940, &H38DB47, &H5CD6A0, &H4896D0, &H344DD5, &H5A4AD0, &H42A4D0, &H2CD4B4, &H52B250, &H3CD558, &H60B540, &H4AB5A0, &H3755A6, _
  &H5C95B0, &H4649B0, &H30A974, &H56A4B0, &H40AA50, &H29AA52, &H4E6D20, &H39AD47, &H5EAB60, &H489370, &H344AF5, &H5A4970, &H4464B0, &H2C74A3, &H50EA50, &H3D6A58, &H6256A0, &H4AAAD0, &H3696D5, &H5C92E0, _
  &H46C960, &H2ED954, &H54D4A0, &H3EDA50, &H2A7552, &H4E56A0, &H38A7A7, &H5EA5D0, &H4A92B0, &H32AAB5, &H58A950, &H42B4A0, &H2CBAA4, &H50AD50, &H3C55D9, &H624BA0, &H4CA5B0, &H375176, &H5C5270, &H466930, _
  &H307934, &H546AA0, &H3EAD50, &H2A5B52, &H504B60, &H38A6E6, &H5EA4E0, &H48D260, &H32EA65, &H56D520, &H40DAA0, &H2D56A3, &H5256D0, &H3C4AFB, &H6249D0, &H4CA4D0, &H37D0B6, &H5AB250, &H44B520, &H2EDD25, _
  &H54B5A0, &H3E55D0, &H2A55B2, &H5049B0, &H3AA577, &H5EA4B0, &H48AA50, &H33B255, &H586D20, &H40AD60, &H2D4B63, &H525370, &H3E49E8, &H60C970, &H4C54B0, &H3768A6, &H5ADA50, &H445AA0, &H2FA6A4, &H54AAD0, _
  &H4052E0, &H28D2E3, &H4EC950, &H38D557, &H5ED4A0, &H46D950, &H325D55, &H5856A0, &H42A6D0, &H2C55D4, &H5252B0, &H3CA9B8, &H62A930, &H4AB490, &H34B6A6, &H5AAD50, &H4655A0, &H2EAB64, &H54A570, &H4052B0, _
  &H2AB173, &H4E6930, &H386B37, &H5E6AA0, &H48AD50, &H332AD5, &H582B60, &H42A570, &H2E52E4, &H50D160, &H3AE958, &H60D520, &H4ADA90, &H355AA6, &H5A56D0, &H462AE0, &H30A9D4, &H54A2D0, &H3ED150, &H28E952, _
  &H4EB520, &H38D727, &H5EADA0, &H4A55B0, &H362DB5, &H5A45B0, &H44A2B0, &H2EB2B4, &H54A950, &H3CB559, &H626B20, &H4CAD50, &H385766, &H5C5370, &H484570, &H326574, &H5852B0, &H406950, &H2A7953, &H505AA0, _
  &H3BAAA7, &H5EA6D0, &H4A4AE0, &H35A2E5, &H5AA550, &H42D2A0, &H2DE2A4, &H52D550, &H3E5ABB, &H6256A0, &H4C96D0, &H3949B6, &H5E4AB0, &H46A8D0, &H30D4B5, &H56B290, &H40B550, &H2A6D52, &H504DA0, &H3B9567, _
  &H609570, &H4A49B0, &H34A975, &H5A64B0, &H446A90, &H2CBA94, &H526B50, &H3E2B60, &H28AB61, &H4C9570, &H384AE6, &H5CD160, &H46E4A0, &H2EED25, &H54DA90, &H405B50, &H2C36D3, &H502AE0, &H3A93D7, &H6092D0, _
  &H4AC950, &H32D556, &H58B4A0, &H42B690, &H2E5D94, &H5255B0, &H3E25FA, &H6425B0, &H4E92B0, &H36AAB6, &H5C6950, &H4674A0, &H31B2A5, &H54AD50, &H4055A0, &H2AAB73, &H522570, &H3A5377, &H6052B0, &H4A6950, _
  &H346D56, &H585AA0, &H42AB50, &H2E56D4, &H544AE0, &H3CA570, &H2864D2, &H4CD260, &H36EAA6, &H5AD550, &H465AA0, &H30ADA5, &H5695D0, &H404AD0, &H2AA9B3, &H50A4D0, &H3AD2B7, &H5EB250, &H48B540, &H33D556) '' /* Years 2100-2199 */
  
  licham = TransLu(Day(ngayduong), Month(ngayduong), Year(ngayduong))
  End Function

• RE: Đổi ngày dương lịch sang ngày âm lịch

  Noname > 05-04-12, 07:09 PM

  ý của bạn xuân kiên là gì thế?

• RE: Đổi ngày dương lịch sang ngày âm lịch

  quanghoasla > 06-04-12, 12:01 AM

  HIIIII em thấy có 2 ngày âm lịch và 2 ngày dương lịch là thế nào nhỉ? chỉ đổi 1 ngày ra nhiều thế ạ?

• RE: Đổi ngày dương lịch sang ngày âm lịch

  Noname > 06-04-12, 12:54 AM

  cái demo này ô thứ nhất dùng nhập ngày dương lịch
  Ô thứ 2: đổi ngày dương sang âm.
  Ô thứ 3: Chuẩn hóa ngày dương lịch
  Ô thứ tư: Đổi ngày âm lịch sang dương lịch
• Bài trước Bài tiếp