[Help] Tạo form định dạng ngày tháng, kiểu số trực tiếp vào Registry (1 người xem)

[quyenpv]

Từ bài của sư phụ:
http://www.giaiphapexcel.com/forum/...ỊNH-DẠNG-NUMBER-TRỰC-TIẾP-KHI-GÕ-TRÊN-TEXTBOX
Nhờ các anh chị tạo form định dạng ngày tháng, kiểu số trực tiếp vào Registry
- Có thể định dạng ngày theo các kiểu dd/mm/yyyy hoặc mm/dd/yyyy
- Kiểu số theo kiểu Việt Nam hoặc quốc tế
Sau khi thiết lệp lưu vào Registry với ạ

Em có sưu tầm được một kiểu sửa nhưng bằng cách trực tiếp không cho chọn như mong muốn

Public Sub Set_ControlPanel()
Const HKEY_CURRENT_USER = &H80000001
Set oSystem = GetObject("winmgmts:\root\default:StdRegProv")
        strKeyPath = "Control Panel\International"
        strValueName = "sDecimal"
        strValue = ","
        oSystem.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
Set oSystem = GetObject("winmgmts:\root\default:StdRegProv")
        strKeyPath = "Control Panel\International"
        strValueName = "sList"
        strValue = ";"
        oSystem.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
Set oSystem = GetObject("winmgmts:\root\default:StdRegProv")
        strKeyPath = "Control Panel\International"
        strValueName = "sThousand"
        strValue = "."
        oSystem.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
Set oSystem = GetObject("winmgmts:\root\default:StdRegProv")
        strKeyPath = "Control Panel\International"
        strValueName = "sShortDate"
        strValue = "dd/MM/yyyy"
        oSystem.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
MsgBox "Da thiet lap xong"
End Sub

Thanks các anh chị

 

[quyenpv]

Em có thiết kế Form mẫu mà không code được, các anh giúp đỡ theo ý tưởng này với ạ.
Các anh cho em hỏi với làm sao em không gõ được tiếng Việt trên Form vậy

 

[quyenpv]

Các anh chị giúp em với ạ

 

[Quang_Hải]

Em có thiết kế Form mẫu mà không code được, các anh giúp đỡ theo ý tưởng này với ạ.
Các anh cho em hỏi với làm sao em không gõ được tiếng Việt trên Form vậy

Bài này có cách làm, cũng tương đối đơn giản. Nhưng giờ chưa có thời gian. Lúc nào rảnh mình viết cho. Chắc phải dùng hàm API gì đó.

 

[Quang_Hải]

Em có thiết kế Form mẫu mà không code được, các anh giúp đỡ theo ý tưởng này với ạ.
Các anh cho em hỏi với làm sao em không gõ được tiếng Việt trên Form vậy

Tặng bạn và các thành viên GPE code định dạng số và ngày theo cách đơn giản nhất.
Các bạn test và cùng hoàn thiện thêm. Code này mình chỉ mới thử viết, chắc còn phải chỉnh nhiều.

 

[Lê Duy Thương]

Tặng bạn và các thành viên GPE code định dạng số và ngày theo cách đơn giản nhất.

win64 bit lỗi dòng khai báo API đầu tiên nha anh hải

 

[Quang_Hải]

win64 bit lỗi dòng khai báo API đầu tiên nha anh hải

Sao lạ vậy ta. Mình xài Win64 mà

 

[Lê Duy Thương]

Sao lạ vậy ta. Mình xài Win64 mà

nhìn key là biết win crack. chắc là crk nên code chạy

 

[Quang_Hải]

nhìn key là biết win crack. chắc là crk nên code chạy

Còn gì nữa chứ. Bữa nào cài Win bản quyền thử coi sao. Nói chung chỉ là quậy thôi chứ không hiểu rõ lắm.

 

[Lê Duy Thương]

Còn gì nữa chứ. Bữa nào cài Win bản quyền thử coi sao. Nói chung chỉ là quậy thôi chứ không hiểu rõ lắm.

anh thích thì em tặng thôi.

 

[Quang_Hải]

win64 bit lỗi dòng khai báo API đầu tiên nha anh hải

Thử code này coi sao Thương
Vụ này là do bộ Office 2013 của Thương xài 64bit chứ không phải do Win

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
#Else
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
#End If
Public Sub ChangeRegionalFormat()
Dim DateFormat As String
Dim DecimalFormat As String, ThousandFormat As String
With UserForm1
   DecimalFormat = IIf(.OptionButton1, ",", ".")
   ThousandFormat = IIf(.OptionButton1, ".", ",")
   DateFormat = IIf(.OptionButton3, "dd-MMM-yyyy", "MMM-dd-yyyy")
End With
SetLocaleInfo 1033, &H1F, DateFormat
SetLocaleInfo 1033, &HE, DecimalFormat
SetLocaleInfo 1033, &HF, ThousandFormat
RestartExcel
End Sub
Sub RestartExcel()
ThisWorkbook.Save
ThisWorkbook.ChangeFileAccess xlReadOnly
Shell "Excel.exe """ & ThisWorkbook.FullName & """"
Application.Quit
End Sub
Sub Auto_Open()
Application.WindowState = XlWindowState.xlMaximized
UserForm1.Show
End Sub

 

[quyenpv]

Anh ơi các này ngày thì đổi mà kiểu số không đổi anh ạ. ANh kiểm tra lại giúp em với

 

[Kiều Mạnh]

Thử code này coi sao Thương
Vụ này là do bộ Office 2013 của Thương xài 64bit chứ không phải do Win

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
#Else
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
#End If
Public Sub ChangeRegionalFormat()
Dim DateFormat As String
Dim DecimalFormat As String, ThousandFormat As String
With UserForm1
   DecimalFormat = IIf(.OptionButton1, ",", ".")
   ThousandFormat = IIf(.OptionButton1, ".", ",")
   DateFormat = IIf(.OptionButton3, "dd-MMM-yyyy", "MMM-dd-yyyy")
End With
SetLocaleInfo 1033, &H1F, DateFormat
SetLocaleInfo 1033, &HE, DecimalFormat
SetLocaleInfo 1033, &HF, ThousandFormat
RestartExcel
End Sub
Sub RestartExcel()
ThisWorkbook.Save
ThisWorkbook.ChangeFileAccess xlReadOnly
Shell "Excel.exe """ & ThisWorkbook.FullName & """"
Application.Quit
End Sub
Sub Auto_Open()
Application.WindowState = XlWindowState.xlMaximized
UserForm1.Show
End Sub

Em test bài #5 và bài #11 này điều OK

 

[Quang_Hải]

Có thành viên nào chạy thử file bài số 5 coi có chuyển được định dạng hay không?

 

[quyenpv]

Ngày thì chuyển đổi được anh! Nhưng định dạng số không được anh ạ

 

[Quang_Hải]

Ngày thì chuyển đổi được anh! Nhưng định dạng số không được anh ạ

Máy tính mình chuyển được, 1 bạn khác cũng đã kiểm tra là được. Vậy bạn xem lại kỹ đi nhé. Mình cũng không chắc lắm.

 

[Lê Duy Thương]

thử code này coi sao thương
vụ này là do bộ office 2013 của thương xài 64bit chứ không phải do win

option explicit
#if vba7 then
private declare ptrsafe function setlocaleinfo lib "kernel32" alias "setlocaleinfoa" (byval locale as long, byval lctype as long, byval lplcdata as string) as boolean
#else
private declare function setlocaleinfo lib "kernel32" alias "setlocaleinfoa" (byval locale as long, byval lctype as long, byval lplcdata as string) as boolean
#end if
public sub changeregionalformat()
dim dateformat as string
dim decimalformat as string, thousandformat as string
with userform1
   decimalformat = iif(.optionbutton1, ",", ".")
   thousandformat = iif(.optionbutton1, ".", ",")
   dateformat = iif(.optionbutton3, "dd-mmm-yyyy", "mmm-dd-yyyy")
end with
setlocaleinfo 1033, &h1f, dateformat
setlocaleinfo 1033, &he, decimalformat
setlocaleinfo 1033, &hf, thousandformat
restartexcel
end sub
sub restartexcel()
thisworkbook.save
thisworkbook.changefileaccess xlreadonly
shell "excel.exe """ & thisworkbook.fullname & """"
application.quit
end sub
sub auto_open()
application.windowstate = xlwindowstate.xlmaximized
userform1.show
end sub

đúng là do bộ office 2013 x64. Code chạy ok rồi