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

Status
Không mở trả lời sau này.

chibi

Thành viên tích cực
Thành viên danh dự
Tham gia ngày
10 Tháng một 2007
Bài viết
1,123
Được thích
621
Điểm
860
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.
 

Đào Việt Cường

Cu Tí sành điệu
Thành viên danh dự
Tham gia ngày
11 Tháng sáu 2006
Bài viết
527
Được thích
757
Điểm
860
Nơi ở
Nha Trang
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:
Mã:
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:

Mã:
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
 
Lần chỉnh sửa cuối:

linhdt

Thành viên chính thức
Tham gia ngày
11 Tháng mười 2006
Bài viết
58
Được thích
108
Điểm
680
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?
 
Chỉnh sửa lần cuối bởi điều hành viên:
Status
Không mở trả lời sau này.
Top Bottom