Tùy chọn
Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
- Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
-
Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
ongke0711 > 15-11-17, 09:27 PM
Thiết lập tự động định dạng ngày/tháng, phân cách hàng ngàn của tiền tệ, số cho hệ thống Windows từ VBA.
—————————————————————————————————————
*** Bổ sung ngày 09/11/2020: Thêm một cách khác dùng WMI để thay đổi Registry của Windows, không cần dùng hàm API.
- Cách này code gọn hơn.
- Nếu tài khoản đăng nhập Windows là Guest sẽ không thiết lập được vì không có quyền sửa hệ thống (Registry).
---------------------------------------------------------------------------------------------------------------------------------
Demo sau đây giúp bạn thiết lập lại các kiểu định dạng ngày/tháng/năm cũng như kiểu tiền tệ, kiểu số cho hệ thống máy tính để phù hợp với định dạng trong ứng dụng Access của bạn. Thiết lập này chạy tự động khi mở ứng dụng, bạn không cần phải đi thiết lập thủ công cho từng máy tính - thay đổi trong Control Panel - Region and Language Setting.
Để thiết lại thông tin của hệ thống Windows, bạn phải dùng tới các hàm API như: SetLocaleInfo (), GetLocaleInfo ().
Dưới đây là code cho hàm ChangeSysDatNumCur(). Copy đoạn code này vào module.
Mã PHP:Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
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
Public Declare PtrSafe Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Public Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
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
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
Public Const LOCALE_ICENTURY = &H24
Public Const LOCALE_ICOUNTRY = &H5
Public Const LOCALE_ICURRDIGITS = &H19
Public Const LOCALE_ICURRENCY = &H1B
Public Const LOCALE_IDATE = &H21
Public Const LOCALE_IDAYLZERO = &H26
Public Const LOCALE_IDEFAULTCODEPAGE = &HB
Public Const LOCALE_IDEFAULTCOUNTRY = &HA
Public Const LOCALE_IDEFAULTLANGUAGE = &H9
Public Const LOCALE_IDIGITS = &H11
Public Const LOCALE_IINTLCURRDIGITS = &H1A
Public Const LOCALE_ILANGUAGE = &H1
Public Const LOCALE_ILDATE = &H22
Public Const LOCALE_ILZERO = &H12
Public Const LOCALE_IMEASURE = &HD
Public Const LOCALE_IMONLZERO = &H27
Public Const LOCALE_INEGCURR = &H1C
Public Const LOCALE_INEGSEPBYSPACE = &H57
Public Const LOCALE_INEGSIGNPOSN = &H53
Public Const LOCALE_INEGSYMPRECEDES = &H56
Public Const LOCALE_IPOSSEPBYSPACE = &H55
Public Const LOCALE_IPOSSIGNPOSN = &H52
Public Const LOCALE_IPOSSYMPRECEDES = &H54
Public Const LOCALE_ITIME = &H23
Public Const LOCALE_ITLZERO = &H25
Public Const LOCALE_NOUSEROVERRIDE = &H80000000
Public Const LOCALE_S1159 = &H28
Public Const LOCALE_S2359 = &H29
Public Const LOCALE_SABBREVCTRYNAME = &H7
Public Const LOCALE_SABBREVDAYNAME1 = &H31
Public Const LOCALE_SABBREVDAYNAME2 = &H32
Public Const LOCALE_SABBREVDAYNAME3 = &H33
Public Const LOCALE_SABBREVDAYNAME4 = &H34
Public Const LOCALE_SABBREVDAYNAME5 = &H35
Public Const LOCALE_SABBREVDAYNAME6 = &H36
Public Const LOCALE_SABBREVDAYNAME7 = &H37
Public Const LOCALE_SABBREVLANGNAME = &H3
Public Const LOCALE_SABBREVMONTHNAME1 = &H44
Public Const LOCALE_SCOUNTRY = &H6
Public Const LOCALE_SCURRENCY = &H14
Public Const LOCALE_SDATE = &H1D
Public Const LOCALE_SDECIMAL = &HE
Public Const LOCALE_SENGCOUNTRY = &H1002
Public Const LOCALE_SENGLANGUAGE = &H1001
Public Const LOCALE_SGROUPING = &H10
Public Const LOCALE_SINTLSYMBOL = &H15
Public Const LOCALE_SLANGUAGE = &H2
Public Const LOCALE_SLIST = &HC
Public Const LOCALE_SLONGDATE = &H20
Public Const LOCALE_SMONDECIMALSEP = &H16
Public Const LOCALE_SMONTHOUSANDSEP = &H17
Public Const LOCALE_SNATIVECTRYNAME = &H8
Public Const LOCALE_SNATIVEDIGITS = &H13
Public Const LOCALE_SNATIVELANGNAME = &H4
Public Const LOCALE_SNEGATIVESIGN = &H51
Public Const LOCALE_SPOSITIVESIGN = &H50
Public Const LOCALE_SSHORTDATE = &H1F
Public Const LOCALE_STHOUSAND = &HF
Public Const LOCALE_STIME = &H1E
Public Const LOCALE_STIMEFORMAT = &H1003
Public Const WM_SETTINGCHANGE = &H1A
Public Const HWND_BROADCAST = &HFFFF&
'Nhap kieu dinh dang Ngay, So
Public Const FormatCurrSymb = "Vnd " 'Ky tu dau cua dang Currency
Public Const FormatDec = "," 'Phan cach so thap phan
Public Const FormatThou = "." 'Phan cach hang ngan
Public Const FormatSDate = "dd-MM-yyyy" 'Kieu Short Date
Public Const FormatLDate = "dd MMMM yyyy" 'Kieu Long Date
Public Sub ChangeSysDatNumCur()
Dim lLocal As Long
Dim LenDate As Long, LenCur As Long, LenNum As Long
Dim dwLCID As Long
Dim BufDate As String * 1024, BufCur As String * 1024, BufNum As String * 1024
On Error GoTo ChangeSysDatNumCur_Error
lLocal = GetSystemDefaultLCID()
LenDate = GetLocaleInfo(lLocal, LOCALE_SSHORTDATE, BufDate, Len(BufDate))
LenCur = GetLocaleInfo(lLocal, LOCALE_SMONTHOUSANDSEP, BufCur, Len(BufCur))
LenNum = GetLocaleInfo(lLocal, LOCALE_STHOUSAND, BufNum, Len(BufNum))
If Not Left$(BufDate, LenDate - 1) = FormatSDate Or Not Left$(BufCur, LenCur - 1) = FormatThou Or Not Left$(BufNum, LenNum - 1) = FormatThou Then 'Kiem tra ngay he thong co cung dinh dang mong muon ko?
dwLCID = GetSystemDefaultLCID()
If SetLocaleInfo(dwLCID, LOCALE_SSHORTDATE, FormatSDate) = False Then 'Thiet lap thu xem co loi ko?
MsgBox "Khong doi duoc dinh dang ngay, so cua he thong.", 64, "Lien he nhan vien Quan tri he thong"
Exit Sub
Else
Change_LocaleInfo
MsgBox "Ung dung se tu khoi dong lai de cac thiet lap co hieu luc.", vbInformation, "Thông báo"
RestartAccessApp.Restart
End If
Else
MsgBox "Dinh dang Ngay/Thang, kieu Tiên te, kieu So phu hop voi ung dung, khong can thiet lap lai." & vbCrLf _
& "- Kieu ngày: " & FormatSDate & vbCrLf _
& "- Kieu so : 1" & FormatThou & "000" & FormatDec & "00", vbInformation, "Chuc mung!"
DoCmd.OpenForm "frmMain"
DoCmd.Close acForm, "frmSplash"
Exit Sub
End If
ChangeSysDatNumCur_Error:
MsgBox "Loi khong xac dinh No. " & Err.Number & _
" trong thu tuc [ChangeSysDatNumCur] cua form khoi dong. " _
& vbCrLf & vbCrLf & Err.Description, 64, "Ung dung Access"
End Sub
Sub Change_LocaleInfo()
Dim LCID As Long
LCID = GetSystemDefaultLCID()
'Thiet lap kieu Ngay/Thang
SetLocaleInfo LCID, LOCALE_SLONGDATE, FormatLDate
SetLocaleInfo LCID, LOCALE_SSHORTDATE, FormatSDate
'Thiet lap kieu tien Currency
SetLocaleInfo LCID, LOCALE_SCURRENCY, FormatCurrSymb
SetLocaleInfo LCID, LOCALE_SMONDECIMALSEP, FormatDec
SetLocaleInfo LCID, LOCALE_SMONTHOUSANDSEP, FormatThou
'Thiet lap kieu so Number
SetLocaleInfo LCID, LOCALE_SDECIMAL, FormatDec
SetLocaleInfo LCID, LOCALE_STHOUSAND, FormatThou
PostMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
End Sub
- Bạn muốn thay đổi kiểu định dạng thì thay đổi ở phần khai báo Hằng: FormatSDate, FormatDec...
![[Hình: 38404423752_3015dfdfe3_o.png]](https://farm5.staticflickr.com/4565/38404423752_3015dfdfe3_o.png)
- Để thay đổi hệ thống có hiệu lực thì buộc phải khởi động lại ứng dụng Access của bạn. Bản thân code VBA Access không thể khởi động lại chính nó vì khi ứng dụng nó đóng (Application.Quit) thì làm sao chạy các code kế tiếp để khởi động lại chính nó. Do vậy phải thông qua một công cụ khác là lệnh Shell để chạy file .bat của DOS. Tác giả Renaud Bompuis đã có đoạn code rất hay thực hiện việc vừa Compact và khởi động lại chính ứng dụng Access nó đang chạy. Tôi có sử dụng code này trong demo.
- Chú ý để đoạn code khởi động lại ứng dụng Access chạy thì bạn phải "bỏ chọn" tính năng "Compact On Close" của Access.
Sau đây là đoạn code để khởi động và nén ứng dụng Access. Copy vào module đặt tên là "RestartAccessApp".
Mã PHP:'-----------------------------------------------------------------------------
' Utilities from http://blog.nkadesign.com/microsoft-access/
' (c) Renaud Bompuis, 2008-2009
' Licensed under the Creative Commons Attribution License
' http://creativecommons.org/licenses/by/3.0/
' http://creativecommons.org/licenses/by/3.0/legalcode
'-----------------------------------------------------------------------------
Option Compare Database
Option Explicit
' Time out set to 60 iterations, after which the batch file should delete itself
Private Const TIMEOUT = 60
Public Sub Restart(Optional Compact As Boolean = False)
Dim scriptpath As String
' Construct the full path of our temporary batch file
scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat"
' if the script already exists, then check it isn't an old remnant
' that has passed it's timeout.
If Dir(scriptpath, vbNormal) <> "" Then
If DateAdd("s", TIMEOUT * 2, FileDateTime(scriptpath)) < Date Then
' We've passed twice the batch file timeout, giving ample time for
' it to exectute, so if it's still there, it's most probably a dud
Kill scriptpath
Else
' Timeout hasn't expired beyond the acceptable limit, so it's probably
' still active, just try to close the application again
Application.Quit acQuitSaveAll
Exit Sub
End If
End If
' Construct the batch file
' Note that the TIMEOUT value is only used as a loop counter and
' we do not really count elapsed time in the batch file.
' The ping command takes some time to load and start and even though
' we set its timeout to 100ms, it will take much longer than that to
' execute.
' If we've been asked to comnpact the database, we launch the database
' using the /compact command line switch
Dim s As String
s = s & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf
s = s & "SET /a counter=0" & vbCrLf
s = s & ":CHECKLOCKFILE" & vbCrLf
s = s & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf
s = s & "SET /a counter+=1" & vbCrLf
s = s & "IF ""!counter!""==""" & TIMEOUT & """ GOTO CLEANUP" & vbCrLf
s = s & "IF EXIST ""%~f2.%4"" GOTO CHECKLOCKFILE" & vbCrLf
If Compact Then
s = s & """%~f1"" ""%~f2.%3"" /compact" & vbCrLf
End If
s = s & "start "" "" ""%~f2.%3""" & vbCrLf
s = s & ":CLEANUP" & vbCrLf
s = s & "del %0"
' Write batch file
Dim intFile As Integer
intFile = FreeFile()
Open scriptpath For Output As #intFile
Print #intFile, s
Close #intFile
' Create the arguments to be passed to the script
' Here we pass it the full path to the database minus the extension which we pass separately
' this is done so that we can reconstruct the path to the lock file easily in the script.
' The extension to the lock file is also passed as a third argument.
Dim dbname As String, ext As String, lockext As String, accesspath As String
Dim idx As Integer
' Get the path to the msaccess executable, wherever that is
accesspath = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
' Find the extension, starting from the end
For idx = Len(CurrentProject.FullName) To 1 Step -1
If Mid(CurrentProject.FullName, idx, 1) = "." Then Exit For
Next idx
dbname = Left(CurrentProject.FullName, idx - 1)
ext = Mid(CurrentProject.FullName, idx + 1)
' Depending on the database extension, determine its lock file extension
If Left(ext, 2) = "ac" Then
lockext = "laccdb"
Else
lockext = "ldb"
End If
' Call the batch file
s = """" & scriptpath & """ """ & accesspath & """ """ & dbname & """ " & ext & " " & lockext
Shell s, vbHide
' Close our application
Application.Quit acQuitSaveAll
End Sub
- Để sử dụng hàm này, trong Form bạn dùng code: RestartAccessApp.Restart True
------------------------------------------------------------------------------------------------------------------
Kết quả:
![[Hình: 38403832322_c16bedfa1d_o.png]](https://farm5.staticflickr.com/4526/38403832322_c16bedfa1d_o.png)
![[Hình: 38403832452_3f66c5503f_o.png]](https://farm5.staticflickr.com/4531/38403832452_3f66c5503f_o.png)
![[Hình: 38403832642_9bcfe9f8e3_o.png]](https://farm5.staticflickr.com/4528/38403832642_9bcfe9f8e3_o.png)
Bạn thay đổi các kiểu định dạng trong Windows để test thử đi nhé. Chạy Form frmSplash trong demo.
Demo dùng hàm API:
Link file demo: http://www.mediafire.com/file/0s2hvcu4fl...NumCur.mdb
Demo dùng WMI thay đổi Registry:
Link file: https://drive.google.com/file/d/1CnDqPtX...sp=sharing -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
vuthaiha90 > 16-11-17, 02:42 PM
Em cảm ơn bác ạ. Rất chi tiết. Em đã áp dụng thành công vào chương trình của em (sửa lại: dd/MM/yyyy; bỏ qua các Msgbox báo thành công, giữ lại Msgbox báo lỗi (vì người dùng lại phải ấn OK thêm lần nữa mới vào được form Startup)) và nó nén chương trình của em lại khá tốt: từ 50Mb xuống 22,6Mb. Em cảm ơn ạ! -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
Minh Tiên > 09-11-20, 12:24 PM
Mình đã test file ChangeSysDateNumCur_Registry. Kết quả:
1. Phần đổi Region rất Ok.
2. Phần khởi động lại: Báo lỗi:
"Loi khong xac dinh No.2046 trong thu tuc [ChangeSysDatNumCur] cua form khoi dong
The command or action "Quit" isn't available now"
Lệnh Quit lỗi ko hoạt động được.
Sau khi thông báo lỗi này File ChangeSysDateNumCur bị khóa ko mở lên trực tiếp từ Explore được. Phải mở Access lên trước rồi mới chọn file mở được.
3. Mình muốn đổi cái List separator từ "," sang ";" luôn thì cần thêm lệnh nào bạn ?
Cảm ơn ongke0711 rất nhiều !
Thân./. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
ongke0711 > 09-11-20, 03:15 PM
(09-11-20, 12:24 PM)Minh Tiên Đã viết: 3. Mình muốn đổi cái List separator từ "," sang ";" luôn thì cần thêm lệnh nào bạn ?
Muốn đổi List Seperator thì thêm cái khoá này vô:
oReg.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sList", strListSep
Bạn khai báo thêm cái biến strListSep:
Private Const strListSep As String = ","
Còn vụ báo lỗi thì mình cũng chưa xác định được vì đang test trên Windows 7 64bit + Office 22016 64 bit thì chạy OK.
Để tối nay cài thêm cái Windows 10 rồi test thử xem. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
Minh Tiên > 09-11-20, 03:49 PM
Thanks onke0711 nhiều nhiều !
Mình đã gỡ được lỗi này rồi, nhưng lại nãy sinh 2 vấn đề:
1. Nếu dùng Restart đi cùng để restart Access thì chương trình báo:
"Can not use 'Tên đường dẫn\file'; file already in use" => Bấm OK nữa thì chương trình Access mở lại. (Ko biết làm sao để xử lý vụ này, ko cho hiện thông báo, mở Access luôn (Đã sử dụng file riêng ko nằm trong Auto Backup and Sync).
2. Vào Control panel thấy đã thay đổi, nhưng hiển thị ngày, tháng, giờ của hệ thống ở góc phải bên dưới mình hình vẫn chưa thay đổi. Tức chưa Apply hệ thống.
Khi đóng, mở một vài chương trình gì đó thì hệ thống hiển thị mới Refresh lại.
Có cách nào để Refresh ngay hệ thống hiển thị này ngày sau khi thực hiện code như Apply thủ công không ?
(Tiên thấy: Nếu chọn thay đổi thủ công, chỉ cần Click Apply là Refresh hệ thống hiển thị này liền).
Thân./. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
ongke0711 > 09-11-20, 05:59 PM
(09-11-20, 03:49 PM)Minh Tiên Đã viết: 2. Vào Control panel thấy đã thay đổi, nhưng hiển thị ngày, tháng, giờ của hệ thống ở góc phải bên dưới mình hình vẫn chưa thay đổi. Tức chưa Apply hệ thống.
Làm vụ này cũng đơn giản là Refresh lại Windows Explorer thôi. Tôi chưa ngâm cứu ra cách mà Windows nó chạy "Apply" applet của Control Panel một cách nhẹ nhàng, trơn tru như vậy. Tạm thời dùng Refresh Explorer.exe vậy.
- Bạn thêm cái hàm Refresh này vào module:
Mã PHP:Function RefreshExplorer()
Dim strComputer As String
Dim oWMIService As Object, oProcess As Object, colProcess As Object
strComputer = "."
Set oWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = oWMIService.ExecQuery("Select * from Win32_Process Where Name = 'explorer.exe'")
For Each oProcess In colProcess
oProcess.Terminate
Next
Set oWMIService = Nothing
Set oProcess = Nothing
Set colProcess = Nothing
End Function
- Gọi nó trong hàm SetSysInfo_reg().
Bạn tải lại file mới ở link bài #1 và chạy test thử hàm này có chạy trong Windows 10 không nhé. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
Minh Tiên > 10-11-20, 09:03 AM
Thanks ongke0711 !
Vụ Apply qua Explorer.exe trên Win10-64 chạy rất OK. Còn vụ Auto Restart thì vẫn không thực hiện được.
Thân./. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
Minh Tiên > 10-11-20, 10:27 AM
Mình mới sưu tầm được một cách Restart Access bằng cách dùng file RestartDb.vbs (VB Script Script File). Mẫu biên soạn trong File Text đính kèm Demo.
Mình chạy thử trong Win10-64, khởi động lại Access rất nhanh (Khởi động lại, ko nén nên không cần bỏ Chế độ "nén" của Access).
Xin chia sẽ để ACE cùng ngâm cứu !
Demo
Thân./. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
ongke0711 > 10-11-20, 12:05 PM
(10-11-20, 10:27 AM)Minh Tiên Đã viết: Mình mới sưu tầm được một cách Restart Access bằng cách dùng file RestartDb.vbs (VB Script Script File). Mẫu biên soạn trong File Text đính kèm Demo.
Mình chạy thử trong Win10-64, khởi động lại Access rất nhanh (Khởi động lại, ko nén nên không cần bỏ Chế độ "nén" của Access).
Xin chia sẽ để ACE cùng ngâm cứu !
Đúng là dùng WScript nó chạy nhanh hơn dùng CMD và đỡ phức tạp hơn. Cách cũ tôi dùng là phải tự động tạo file .bat rồi mới thực thi. Cách này thì tạo sẳn file .vbs và phải đính kèm.
---------------------------------------------------------------------------------------------------
Tôi đã đưa code "Khởi động lại ứng dụng Access" của bạn Minh Tiên vô file ở bài #1 và có chỉnh sửa đôi chút.
- Thêm code để dùng được cho file .mdb
- Tự động tạo file VBS cùng thư mục ứng dụng để chạy, không cần phải đính kèm file VBS cùng với ứng dụng Access. -
RE: Thiết lập tự động Windows Regional ngày/tháng, định dạng tiền, số
Minh Tiên > 09-01-21, 02:29 PM
Nhờ ongke0711 cùng ACE chỉ giúp !
Tiên chạy code RetartAccApp của ongke0711 thì chương trình Access đóng lại => Báo lỗi:
Can not use: 'Tên đường dẫn + Tên File'; file already in use
mà không khởi động lại được.
Tiên ko biết khắc phục kiểu gì ?
Cảm ơn nhiều !