Yêu cầu thiết lập dạng thức kiểu ngày

[chibi]

Bài toán: Khi mở 1 workbook kiểm tra xem Date Format trong Rigional Options đã có dạng "dd/MM/yyyy" chưa. Nếu chưa đúng thì thông báo và thoát.

 

[Nguyễn Duy Tuân]

Tôi không hiểu bạn đố hay hỏi người khác nữa?

 

[Đào Việt Cường]

Dear all,
--------
Chắc là chibi muốn lập trình (vì bài viết nằm trong box Lập trình) một đoạn chương trình kiểm tra định dạng ngày hệ thống? Ý tưởng này rất đáng làm vì theo thói quen (có thể là bắt buộc nữa) của Việt Nam, tiêu chuẩn định dạng ngày tháng phải là ngày-tháng-năm (dd/mm/yyyy). Ở mức căn bản, Code sau đây đáp ứng yêu cầu của bạn:

Private Sub Workbook_Open()
If CStr(Date) <> Format(Date, "dd/mm/yyyy") Then
    If MsgBox("Định gạng ngày hệ thống phải là 'dd/MM/yyyy'. bạn có muốn tiếp tục không?", _
        vbYesNo + vbQuestion, "Short Date Format") = vbNo Then
        Application.DisplayAlerts = False
        ThisWorkbook.Close
    End If
End If
End Sub

Với yêu cầu cao hơn, bạn muốn tuỳ chỉnh thông số này trên máy tính của bạn tất nhiên phải bằng lập trình? Code sau không có gì đáng bàn (không biết bàn thế nào) nhưng đôi lúc sẽ giúp ích cho bạn:

Option Explicit
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long
Private 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
Const LOCALE_SSHORTDATE = &H1F
Const LOCALE_USER_DEFAULT = &H400
[COLOR=silver]'_______________________________[/COLOR]
 
Public Function LPSTRToVBString$(ByVal s$)
Dim nullpos&
nullpos& = InStr(s$, Chr$(0))
If nullpos > 0 Then
LPSTRToVBString = Left$(s$, nullpos - 1)
Else
LPSTRToVBString = ""
End If
End Function
 
 
[COLOR=silver]'______________________________[/COLOR]
[COLOR=darkgreen]'Thủ tục thiết lập lại định dạng ngày hệ thống nếu không đúng tiêu chuẩn '"dd/MM/yyyy"[/COLOR]
Private Sub ShortDateFormat_Set() 
Dim dl As String
Dim buffer As String * 100
dl = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, buffer, 99)
dl = LPSTRToVBString(buffer)
If UCase(dl) <> "DD/MM/YYYY" Then
dl = SetLocaleInfo(0, LOCALE_SSHORTDATE, "dd/MM/yyyy")
End If
End Sub

 

[linhdt]

Cảm ơn Bác Cường, code của bác post rất hay và hữu ích cho người dùng. Bác còn có code nào để hiệu chỉnh trong Display Properties, ở tab Appearance không, nếu muốn hiệu chỉnh font hiển thị trong mục này thì làm thế nào?