• Trang chủ click to expand contents 

  • 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]



    - Để 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]  [Hình: 38403832452_3f66c5503f_o.png]



    [Hình: 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 !