Duong_VBA
Thành viên chính thức


- Tham gia
- 10/11/07
- Bài viết
- 89
- Được thích
- 26
Em muốn từ VBA viết mã thay đổi font, định dạng số và ngày tháng của Windows bằng mã VBA các bác có thể giúp em em với.
Đoạn mã này em thử cho ngay và Money nhưng không thành công, con với Font và số thì chịu, mong các cao thủ chỉ giúp:
Private Const LOCALE_SSHORTDATE = &H1F
Private Const LOCALE_LONGDATE = &H2F
Private Const LOCALE_SCURRENCY = &H14
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&
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 PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
'
Public Function ChangeRegionalSettings(Optional strDateFormat As String = "", Optional strDateFormat1 As String = "", Optional strCurrency As String = "§") As String
Dim dwLCID As Long
Dim strError As String
strError = ""
dwLCID = GetSystemDefaultLCID()
If SetLocaleInfo(dwLCID, LOCALE_SSHORTDATE, strDateFormat) = False Then
MsgBox "Dinh dang ngay thanh Kieu tieng Viet dd/mm/yyyy", , "Thong bao"
strError = strError & " Short Date Style" & vbCrLf
'ChangeRegionalSettings = strError
End If
If SetLocaleInfo(dwLCID, LOCALE_LONGDATE, strDateFormat) = False Then
MsgBox "Dinh dang ngay thang Kieu tieng viet dd/MM/yyyy", , "Thong bao"
strError = strError & " Long Date Style" & vbCrLf
'ChangeRegionalSettings = strError
End If
If SetLocaleInfo(dwLCID, LOCALE_SCURRENCY, strCurrency) = False Then
MsgBox "§· ®Æt tiÒn tÖ Kieu §ång", , "Thong bao tõ hÖ thèng"
strError = strError & " Currency Symbol" & vbCrLf
'ChangeRegionalSettings = strError
End If
ChangeRegionalSettings = strError
' MsgBox strError
If strError <> "" Then
Exit Function
End If
PostMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
End Function
Sub jkj()
Call ChangeRegionalSettings("dd/MM/yyyy", "dd/MM/yyyy", "Dong")
End Sub
Đoạn mã này em thử cho ngay và Money nhưng không thành công, con với Font và số thì chịu, mong các cao thủ chỉ giúp:
Private Const LOCALE_SSHORTDATE = &H1F
Private Const LOCALE_LONGDATE = &H2F
Private Const LOCALE_SCURRENCY = &H14
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&
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 PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
'
Public Function ChangeRegionalSettings(Optional strDateFormat As String = "", Optional strDateFormat1 As String = "", Optional strCurrency As String = "§") As String
Dim dwLCID As Long
Dim strError As String
strError = ""
dwLCID = GetSystemDefaultLCID()
If SetLocaleInfo(dwLCID, LOCALE_SSHORTDATE, strDateFormat) = False Then
MsgBox "Dinh dang ngay thanh Kieu tieng Viet dd/mm/yyyy", , "Thong bao"
strError = strError & " Short Date Style" & vbCrLf
'ChangeRegionalSettings = strError
End If
If SetLocaleInfo(dwLCID, LOCALE_LONGDATE, strDateFormat) = False Then
MsgBox "Dinh dang ngay thang Kieu tieng viet dd/MM/yyyy", , "Thong bao"
strError = strError & " Long Date Style" & vbCrLf
'ChangeRegionalSettings = strError
End If
If SetLocaleInfo(dwLCID, LOCALE_SCURRENCY, strCurrency) = False Then
MsgBox "§· ®Æt tiÒn tÖ Kieu §ång", , "Thong bao tõ hÖ thèng"
strError = strError & " Currency Symbol" & vbCrLf
'ChangeRegionalSettings = strError
End If
ChangeRegionalSettings = strError
' MsgBox strError
If strError <> "" Then
Exit Function
End If
PostMessage HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0
End Function
Sub jkj()
Call ChangeRegionalSettings("dd/MM/yyyy", "dd/MM/yyyy", "Dong")
End Sub