Hỏi cách điều khiển control panel từ VBE

Liên hệ QC

waterblue

Thành viên mới
Tham gia
19/2/09
Bài viết
2
Được thích
0
Trong control panel - region and language, có cho phép
- chỉnh DECIMAL SYMBOL là dấu chấm (.) hay phẩy (,) va ...
- chỉnh DIGIT GROUPING SYMBOL ..

tui muốn điều khiển các giá trị này từ trong VBE

CÁC BÁC CHỈ GIÚP VỚI AH!
 
PHP:
Sub ChangeSystemFormat()
Const HKEY_CURRENT_USER = &H80000001
Set objReg = GetObject("winmgmts:\root\default:StdRegProv")
strKeyPath = "Control Panel\International"
'Decimal symbol
strValueName1 = "sDecimal"
strValue1 = ","
'Digit grouping symbol
strValueName2 = "sThousand"
strValue2 = "."
'Short date
strValueName3 = "sShortDate"
strValue3 = "dd/MM/yyyy"

'Short time
strValueName4 = "sShortTime"
strValue4 = "HH:mm"

'Long time
strValueName5 = "sTimeFormat"
strValue5 = "HH:mm"

'AM symbol
strValueName6 = "s1159"
strValue6 = ""

'PM symbol
strValueName7 = "s2359"
strValue7 = ""

objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName1, strValue1
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName2, strValue2
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName3, strValue3

objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName4, strValue4
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName5, strValue5
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName6, strValue6
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName7, strValue7
End Sub
Tham khảo đoạn code này nhé bạn!
 
Upvote 0
PHP:
Sub ChangeSystemFormat()
Const HKEY_CURRENT_USER = &H80000001
Set objReg = GetObject("winmgmts:\root\default:StdRegProv")
strKeyPath = "Control Panel\International"
'Decimal symbol
strValueName1 = "sDecimal"
strValue1 = ","
'Digit grouping symbol
strValueName2 = "sThousand"
strValue2 = "."
'Short date
strValueName3 = "sShortDate"
strValue3 = "dd/MM/yyyy"

'Short time
strValueName4 = "sShortTime"
strValue4 = "HH:mm"

'Long time
strValueName5 = "sTimeFormat"
strValue5 = "HH:mm"

'AM symbol
strValueName6 = "s1159"
strValue6 = ""

'PM symbol
strValueName7 = "s2359"
strValue7 = ""

objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName1, strValue1
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName2, strValue2
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName3, strValue3

objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName4, strValue4
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName5, strValue5
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName6, strValue6
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName7, strValue7
End Sub
Tham khảo đoạn code này nhé bạn!
Liên quan đến các thiết lập trong Control Panel, tôi chưa thấy code nào có khả năng cập nhật kết quả ngay lập tức sau khi code chạy. Có nghĩa là chạy code xong bạn phải đóng file rồi mở lại thì mới nhìn thấy được thay đổi
-----------------------
Code gần giống của bạn:
Mã:
Sub ChangeSymbol()
  Const DEC = "HKCU\Control Panel\International\sDecimal"
  Const DIG = "HKCU\Control Panel\International\sThousand"
  With CreateObject("WScript.Shell")
    .RegWrite DEC, ",", "REG_SZ"
    .RegWrite DIG, ".", "REG_SZ"
  End With
End Sub
Nhưng cũng không cập nhật sau khi code chạy
 
Upvote 0
Trong control panel - region and language, có cho phép
- chỉnh DECIMAL SYMBOL là dấu chấm (.) hay phẩy (,) va ...
- chỉnh DIGIT GROUPING SYMBOL ..
tui muốn điều khiển các giá trị này từ trong VBE
Việc thiết lập trong CP thì dễ thôi. Vấn đề là làm mới thiết lập trong Excel. Mỗi lần Excel được khởi động thì nó lấy thiết lập mới nhất trong CP. Nếu bạn mở Excel rồi mới thay đổi thiết lập bằng tay, tức tự vào CP rồi thay đổi, thì Excel sẽ làm mới tức thì. Nếu mở Excel rồi mới thay đổi trong CP nhưng làm bằng code thì Excel không làm mới. Tại sao lại khác với thay đổi trong CP bằng tay? Khi làm bằng tay thì ta phải tự vào CP, tức có những applet được chạy, và khi ta thay đổi thiết lập trong CP thì chúng gửi thông điệp để thông báo cho tất cả các ứng dụng trong system biết là đã có thay đổi trong thiết lập của system. Mục đích là để các ứng dụng chạy trong system làm mới thông tin. Khi ta thay đổi thiết lập trong CP bằng code thì không có ông nào LOA LOA LOA cho các ứng dựng trong system biết để làm mới thông tin. Vậy thì sau khi thay đổi thiết lập thì ta phải tự tạo ra một ông cầm tù và để ông ta LOA LOA LOA cho bàn dân thiên hạ biết. Có 3 cách tạo ông LOA LOA LOA:

1. Có thể tạo 1 EXE nhỏ gọn vd. loaloa.exe trong VB6 với code Module1
Mã:
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Sub Main()
    Sleep 1000
    SendMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
End Sub

2. Trong notepad tạo tập tin SettingChange.VBS có nội dung
Mã:
Dim excel, strMacro
Set excel = CreateObject("Excel.Application")
strMacro = "CALL(""user32"", ""SendMessageA"", ""JJJJJ"", -1, 26, 0, 0)"
excel.ExecuteExcel4Macro(strMacro)

Như vậy sau khi chạy code để thay đổi trong CP thì chạy loaloa.exe hoặc SettingChange.VBS để LOA LOA cho bàn dân thiên hạ biết để cập nhật thiết lập.

Nhưng 2 cách này là bán tự động. Cách tự động hoàn toàn là cách 3. Lưu ý là tôi chỉ kiểm tra với Excel 32 bit. Cụ thể là Windows 10 64 bit + Excel 2013 32 bit. Rất có thể với Excel 64 sẽ có lỗi, không chạy. Tôi không có Excel 64 bit và cũng không có ý định tìm hiểu. Làm chơi thôi, không thề danh dự là phải làm bằng được.

3. Chèn Module với code sau.
Mã:
Option Explicit
 
'    LOA LOA cho bàn dân thiên hạ biết về sự thay đổi trong system để cập nhật thiết lập
Sub BroadcastSettingChange()
Dim s As String, filename As String
    filename = ThisWorkbook.Path & "\SettingChange.vbs"
    Open filename For Output As #1
    s = "Dim excel, strMacro"
    Print #1, s
    s = "Set excel = CreateObject(""Excel.Application"")"
    Print #1, s
    s = "strMacro = ""CALL(""""user32"""", """"SendMessageA"""", """"JJJJJ"""", -1, 26, 0, 0)"""
    Print #1, s
    s = "excel.ExecuteExcel4Macro(strMacro)"
    Print #1, s
    Close #1
    
    shell "wscript " & filename, vbNormalFocus
    Application.Wait Now + TimeValue("0:00:05")
    Kill filename
End Sub

'    thay đổi thiết lập dấu thập phân và dấu phân cách hàng nghìn
Sub setting_symbol(ByVal sDecimal As String, ByVal sThousand As String)
Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
    With shell
        .RegWrite "HKCU\Control Panel\International\sDecimal", sDecimal, "REG_SZ"
        .RegWrite "HKCU\Control Panel\International\sThousand", sThousand, "REG_SZ"
    End With
    Set shell = Nothing
    BroadcastSettingChange
End Sub

'    ví dụ về sử dụng thiết lập dấu phẩy là dấu thập phân, và dấu chấm là dấu phân cách hàng nghìn
'    code cụ thể chỉ gọi sub setting_symbol
Sub test()
    setting_symbol ",", "."
End Sub
 
Upvote 0
Việc thiết lập trong CP thì dễ thôi. Vấn đề là làm mới thiết lập trong Excel. Mỗi lần Excel được khởi động thì nó lấy thiết lập mới nhất trong CP. Nếu bạn mở Excel rồi mới thay đổi thiết lập bằng tay, tức tự vào CP rồi thay đổi, thì Excel sẽ làm mới tức thì. Nếu mở Excel rồi mới thay đổi trong CP nhưng làm bằng code thì Excel không làm mới. Tại sao lại khác với thay đổi trong CP bằng tay? Khi làm bằng tay thì ta phải tự vào CP, tức có những applet được chạy, và khi ta thay đổi thiết lập trong CP thì chúng gửi thông điệp để thông báo cho tất cả các ứng dụng trong system biết là đã có thay đổi trong thiết lập của system. Mục đích là để các ứng dụng chạy trong system làm mới thông tin. Khi ta thay đổi thiết lập trong CP bằng code thì không có ông nào LOA LOA LOA cho các ứng dựng trong system biết để làm mới thông tin. Vậy thì sau khi thay đổi thiết lập thì ta phải tự tạo ra một ông cầm tù và để ông ta LOA LOA LOA cho bàn dân thiên hạ biết. Có 3 cách tạo ông LOA LOA LOA:

1. Có thể tạo 1 EXE nhỏ gọn vd. loaloa.exe trong VB6 với code Module1
Mã:
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Sub Main()
    Sleep 1000
    SendMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
End Sub

2. Trong notepad tạo tập tin SettingChange.VBS có nội dung
Mã:
Dim excel, strMacro
Set excel = CreateObject("Excel.Application")
strMacro = "CALL(""user32"", ""SendMessageA"", ""JJJJJ"", -1, 26, 0, 0)"
excel.ExecuteExcel4Macro(strMacro)

Như vậy sau khi chạy code để thay đổi trong CP thì chạy loaloa.exe hoặc SettingChange.VBS để LOA LOA cho bàn dân thiên hạ biết để cập nhật thiết lập.

Nhưng 2 cách này là bán tự động. Cách tự động hoàn toàn là cách 3. Lưu ý là tôi chỉ kiểm tra với Excel 32 bit. Cụ thể là Windows 10 64 bit + Excel 2013 32 bit. Rất có thể với Excel 64 sẽ có lỗi, không chạy. Tôi không có Excel 64 bit và cũng không có ý định tìm hiểu. Làm chơi thôi, không thề danh dự là phải làm bằng được.

3. Chèn Module với code sau.
Mã:
Option Explicit

'    LOA LOA cho bàn dân thiên hạ biết về sự thay đổi trong system để cập nhật thiết lập
Sub BroadcastSettingChange()
Dim s As String, filename As String
    filename = ThisWorkbook.Path & "\SettingChange.vbs"
    Open filename For Output As #1
    s = "Dim excel, strMacro"
    Print #1, s
    s = "Set excel = CreateObject(""Excel.Application"")"
    Print #1, s
    s = "strMacro = ""CALL(""""user32"""", """"SendMessageA"""", """"JJJJJ"""", -1, 26, 0, 0)"""
    Print #1, s
    s = "excel.ExecuteExcel4Macro(strMacro)"
    Print #1, s
    Close #1

    shell "wscript " & filename, vbNormalFocus
    Application.Wait Now + TimeValue("0:00:05")
    Kill filename
End Sub

'    thay đổi thiết lập dấu thập phân và dấu phân cách hàng nghìn
Sub setting_symbol(ByVal sDecimal As String, ByVal sThousand As String)
Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
    With shell
        .RegWrite "HKCU\Control Panel\International\sDecimal", sDecimal, "REG_SZ"
        .RegWrite "HKCU\Control Panel\International\sThousand", sThousand, "REG_SZ"
    End With
    Set shell = Nothing
    BroadcastSettingChange
End Sub

'    ví dụ về sử dụng thiết lập dấu phẩy là dấu thập phân, và dấu chấm là dấu phân cách hàng nghìn
'    code cụ thể chỉ gọi sub setting_symbol
Sub test()
    setting_symbol ",", "."
End Sub
Cảm ơn Anh ... code hay thật ... Em xài Officex64 chạy OK
mà viết trên VB6 thì Office x32 & x64 với em là như nhau cả thôi :p
Vậy là em có thêm 1 hàm cho VB6 xài khi cần thiết

cho em hỏi ké thêm chút khi em muốn thiết lập lại ngày tháng là: dd/mm/yyyy thì viết lại sao Anh ?
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn Anh ... code hay thật ... Em xài Officex64 chạy OK
mà viết trên VB6 thì Office x32 & x64 với em là như nhau cả thôi :p
Vậy là em có thêm 1 hàm cho VB6 xài khi cần thiết

cho em hỏi ké thêm chút khi em muốn thiết lập lại ngày tháng là: dd/mm/yyyy thì viết lại sao Anh ?
Xem ở đây nhé, chắc giúp ích được
Tôi chưa thử , vì chưa thấy có nhu cầu, ControlPanel sinh ra đã tiện, giờ ta lại muốn tiện to hơn thì chắc hiếm khi cần
 
Upvote 0
Cảm ơn Anh ... code hay thật ... Em xài Officex64 chạy OK
mà viết trên VB6 thì Office x32 & x64 với em là như nhau cả thôi :p
Vậy là em có thêm 1 hàm cho VB6 xài khi cần thiết
cho em hỏi ké thêm chút khi em muốn thiết lập lại ngày tháng là: dd/mm/yyyy thì viết lại sao Anh ?
VBA thì quá tầm thường rồi. Bạn lập trình trong VB6 và Delphi nên món bạn khoái nhất là Windows API.

Về GetLocaleInfo tôi đã có ví dụ 7 năm trước, trong bài #8


Có tập tin đàng hoàng. Đọc thêm về SetLocaleInfo. Chỉ khác nhau là 1 cái là Set còn cái kia là Get. Ngoài ra dùng tương tự, các tham số tương tự.

Sau đây là code trong VB6 - VBA. Nếu bạn làm trong Dephi thì cũng các hàm ấy, các hằng số ấy, chỉ là trong Delphi bạn không phải khai báo như trên mà chỉ cần cho unit (trong Delphi 5 mà tôi nghịch thì là unit Windows) vào trong uses. Thế thôi.
Mã:
Private Const LOCALE_SSHORTDATE = &H1F
Private Const LOCALE_STIMEFORMAT = &H1003
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () 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

Public Function SetDateTime() As Boolean
Dim locale As Long
    locale = GetSystemDefaultLCID()
    If SetLocaleInfo(locale, LOCALE_SSHORTDATE, "dd/MM/yyyy") = False Then Exit Function
    'If SetLocaleInfo(locale, LOCALE_STIMEFORMAT, "HH:mm:ss") = False Then Exit Function
   
    ' thong bao cho cac application (HWND_BROADCAST co nghia la thong diep duoc gui toi
    ' tat ca cac cua so trong system) rang thiet lap da thay doi
    SendMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
    SetDateTime = True
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
VBA thì quá tầm thường rồi. Bạn lập trình trong VB6 và Delphi nên món bạn khoái nhất là Windows API.

Về GetLocaleInfo tôi đã có ví dụ 7 năm trước, trong bài #8


Có tập tin đàng hoàng. Đọc thêm về SetLocaleInfo. Chỉ khác nhau là 1 cái là Set còn cái kia là Get. Ngoài ra dùng tương tự, các tham số tương tự.

Sau đây là code trong VB6 - VBA. Nếu bạn làm trong Dephi thì cũng các hàm ấy, các hằng số ấy, chỉ là trong Delphi bạn không phải khai báo như trên mà chỉ cần cho unit (trong Delphi 5 mà tôi nghịch thì là unit Windows) vào trong uses. Thế thôi.
Mã:
Private Const LOCALE_SDATE = &H1F
Private Const LOCALE_STIMEFORMAT = &H1003
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () 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

Public Function SetDateTime() As Boolean
Dim locale As Long
    locale = GetSystemDefaultLCID()
    If SetLocaleInfo(locale, LOCALE_SDATE, "dd/MM/yyyy") = False Then Exit Function
    'If SetLocaleInfo(locale, LOCALE_STIMEFORMAT, "HH:mm:ss") = False Then Exit Function
 
    ' thong bao cho cac application (HWND_BROADCAST co nghia la thong diep duoc gui toi
    ' tat ca cac cua so trong system) rang thiet lap da thay doi
    SendMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
    SetDateTime = True
End Function
Trên VBA & VB6 Anh chỉ vầy là quá Ok với Em rồi đó

Tiện đây Anh chỉ Em cách Code trên Delphi với . Em chưa hình dung ra cách viết như thế nào ???
Delphi 5 hay Delphi 10.2.3 của Em thì cũng thế thôi cơ bản code là như nhau chỉ khác nhau các bản sau này nó hổ trợ tốt hơn
Vì Em có xem nhiều hàm viết từ Dephi 5 tới giờ vần chạy tốt chỉ có một số cái họ xài thành phần của bên thứ 3,4 gì đó khi mở lại không có cái Unit đó là nó báo lỗi ( Em hiểu theo cảm tính thế .... nếu nói sai Anh chỉnh lại cho đúng dùm Em vì code két Em tự mò là chính nên nhiều khi nói bạy chút ... bỏ qua cho em)
 
Upvote 0
Trên VBA & VB6 Anh chỉ vầy là quá Ok với Em rồi đó

Tiện đây Anh chỉ Em cách Code trên Delphi với . Em chưa hình dung ra cách viết như thế nào ???
Delphi 5 hay Delphi 10.2.3 của Em thì cũng thế thôi cơ bản code là như nhau chỉ khác nhau các bản sau này nó hổ trợ tốt hơn
Vì Em có xem nhiều hàm viết từ Dephi 5 tới giờ vần chạy tốt chỉ có một số cái họ xài thành phần của bên thứ 3,4 gì đó khi mở lại không có cái Unit đó là nó báo lỗi ( Em hiểu theo cảm tính thế .... nếu nói sai Anh chỉnh lại cho đúng dùm Em vì code két Em tự mò là chính nên nhiều khi nói bạy chút ... bỏ qua cho em)
Bạn có tên các hàm và các hằng số cần dùng. Code trong VB6 và Delphi chỉ khác nhau về cú pháp.

Nhưng có 1 cái sai mà tôi không kiểm tra kỹ. Do bạn cần thiết lập ngày dạng ngắn (31/10/2020) chứ không phải dạng dài (31 Tháng Mười 2020) nên không phải LOCALE_SDATE mà phải là LOCALE_SSHORTDATE

Trong Delphi
Mã:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  locale: DWORD;
begin
  locale := GetSystemDefaultLCID;
  If SetLocaleInfo(locale, LOCALE_SSHORTDATE, 'dd/MM/yyyy') then
    SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
end;

end.
 
Upvote 0
Bạn có tên các hàm và các hằng số cần dùng. Code trong VB6 và Delphi chỉ khác nhau về cú pháp.

Nhưng có 1 cái sai mà tôi không kiểm tra kỹ. Do bạn cần thiết lập ngày dạng ngắn (31/10/2020) chứ không phải dạng dài (31 Tháng Mười 2020) nên không phải LOCALE_SDATE mà phải là LOCALE_SSHORTDATE

Trong Delphi
Mã:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  locale: DWORD;
begin
  locale := GetSystemDefaultLCID;
  If SetLocaleInfo(locale, LOCALE_SSHORTDATE, 'dd/MM/yyyy') then
    SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
end;

end.
chính xác cảm ơn Anh ... thay đổi ngay và luôn
1604134874489.png
 
Upvote 0
Web KT
Back
Top Bottom