เคยโพสต์ไว้แล้วครับ
ตอนแรกก็ใช้งานได้ดี แต่ทีนี้ ผมเจอปัญหาอย่างนี้ครับ



ถ้าดูตามรูป เมื่อเราตั้งค่า System date เราจะเป็น Dialog หมายเลข 1
ถ้าเรากดปุ่ม Custumize เราจะเห็น Dialog เพิ่มมาอีกเป็นหมายเลข 2

บางคนตั้งค่าที่ dialog1 เป็น English (United State)
แล้ว dialog ด้านใน มันจะเลือกชนิดปี (calendar type) ไม่ได้ครับ มันจะตั้งให้เป็นแบบ คริสต์โดยอัตโนมัติเลย

แต่บางคนตั้งค่าใน dialog1 เป็น Thai ส่วนใน dialog 2 ซึ่งมันสามารถเลือก calendar type ได้ 2 รูปแบบครับ คือแบบพุทธหรือแบบคริสต์

ดังนั้นความเป็นไปได้ ในการที่จะเอาโปรแกรมของเราไปรันที่เครื่องปลายทาง แล้วจะเจอ คือมันมี สามทาง เมื่อเราใช้ฟังชั่น GettbLoginLocaleInfo ที่ผมเคยเอามาโพสต์ มันจึงได้ค่าที่ผิดพลาดครับ

ผมไปปรับแต่งเอามาใหม่ ทีนี้เอาแบบรันได้ทั้งบนวินโดวส์ 32bit (x86) และรันได้บนระบบ 64bit เลยทีเดียว

เหมาะสำหรับการใช้ร่วมกับ การรันเลขที่อัตโนมัติ ครับ
- IV 5501001 หรือ IV 1201001   (ความหมายเลขที่คือ เอกสารขายลำดับที่ 1 ของเดือนมกราคม ปีพุทธศักราช 2555)
- PO 5501012 หรือ PO 1201012 (เอกสารใบสั่งซื้อลำดับที่ 12 ที่ออกในเดือนมกราคม ปีพุทธศักราช 2555)
เช่น ฐานข้อมูลวางไว้ที่เครื่องหลัก แล้วมี front-end แจกไปหลายๆ client แต่ละ client อาจใช้ระบบ system date แตกต่างกันเมื่อจะสร้างเอกสารฉบับใหม่ อาจทำให้เกิดรูปแบบเลขที่อัตโนมัติที่ไม่เหมือนกันก็ได้ หากเราต้องเขียนโปรแกรมเราก็ดักไว้ให้ครบเลยครับ นี่คือโมดูล เก็บไว้ใช้ติดบ้านนะครับ อิอิ

Option Compare Database
#If Win64 Then
Public Declare PtrSafe Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare PtrSafe Function GetLocaleInfo Lib "kernel32" _
Alias "GetLocaleInfoA" _
(ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long
#Else
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare Function GetLocaleInfo Lib "kernel32" _
Alias "GetLocaleInfoA" _
(ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long
#End If

Public Function GettbLoginLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String
Dim sReturn As String
Dim r As Long
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
If r Then
sReturn = Space$(r)
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
If r Then GettbLoginLocaleInfo = Left$(sReturn, r - 1)
End If
End Function

Public Function cYear(ByVal yourDate As Date) As Long
' เปลี่ยนเลขที่ จากระบบใดๆ ให้เป็นแบบคริสต์เสมอ
cYear = Year(yourDate)
If GettbLoginLocaleInfo(GetSystemDefaultLCID(), &H1005) = 1 And GettbLoginLocaleInfo(GetSystemDefaultLCID(), &H1009) = 7 Then cYear = Year(yourDate) - 543
End Function

Public Function bYear(ByVal yourDate As Date) As Long
' เปลี่ยนเลขที่ จากระบบใดๆ ให้เป็นแบบพุทธเสมอ
bYear = Year(yourDate) + 543
If GettbLoginLocaleInfo(GetSystemDefaultLCID(), &H1005) = 1 And GettbLoginLocaleInfo(GetSystemDefaultLCID(), &H1009) = 7 Then bYear = Year(yourDate)
End Function