Tôi đang dùng 1 file Excel mà giá trị tính toán có dựa vào thời gian của hệ thống. Tuy nhiên một vài máy tính có thời gian chạy không đúng.
Vậy có Code nào để khi chạy mở file excel, Windows sẽ bị buộc phải cập nhật ngày giờ qua Internet Time Update.
Ngoài ra nếu được có thể tự chỉnh lại định dạng ngày tháng trong hệ thống không ?
Tôi đang dùng 1 file Excel mà giá trị tính toán có dựa vào thời gian của hệ thống. Tuy nhiên một vài máy tính có thời gian chạy không đúng.
Vậy có Code nào để khi chạy mở file excel, Windows sẽ bị buộc phải cập nhật ngày giờ qua Internet Time Update.
Ngoài ra nếu được có thể tự chỉnh lại định dạng ngày tháng trong hệ thống không ?
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Integer
Mã:
Sub DownloadFile(ByVal sURL As String, ByVal FileName As String)
DeleteUrlCacheEntry sURL
URLDownloadToFile 0, sURL, FileName, 0, 0
End Sub
Mã:
[code]
Function InternetTime()
Dim sTmp As String, sURL As String, FileName
Dim fso As Object
sURL = "http://www.timeanddate.com/worldclock/city.html?n=95"
FileName = "C:\InternetDate.dat"
DownloadFile sURL, FileName
Set fso = CreateObject("Scripting.FileSystemObject")
With fso.OpenTextFile(FileName, 1)
sTmp = .ReadAll
sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))
sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</strong>") - 1)
sTmp = Mid(sTmp, InStr(1, sTmp, "big>") + 4)
sTmp = Mid(sTmp, InStr(1, sTmp, "at ") + 3)
.Close
End With
InternetTime = Format(TimeValue(sTmp), "hh:mm:ss")
Set fso = Nothing: Kill (FileName)
End Function
Và cuối cùng là Sub để Set time cho hệ thống
Mã:
Sub Main()
Dim sComm As String, sTime As String
sTime = InternetTime
sComm = "cmd.exe /c Time " & sTime
CreateObject("WScript.Shell").Run sComm, 0, True
End Sub
Bạn test thử, tôi không chắc (Test bằng cách chỉnh cho sai giờ hệ thống rồi chạy code xem giờ hệ thống đã đúng chưa)
Yêu cầu: Muốn chạy code phải kết nối internet (đương nhiên)
Bạn test thử, tôi không chắc (Test bằng cách chỉnh cho sai giờ hệ thống rồi chạy code xem giờ hệ thống đã đúng chưa) Yêu cầu: Muốn chạy code phải kết nối internet (đương nhiên)
Đúng rồi, ngày tháng hơi khó 1 chút vì phải xem Control Panel đang định dạng là d/M/y hay M/d/y
Giờ viết lại, Set cả ngày và giờ luôn nhé:
Mã:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Integer
Mã:
Sub DownloadFile(ByVal sURL As String, ByVal FileName As String)
DeleteUrlCacheEntry sURL
URLDownloadToFile 0, sURL, FileName, 0, 0
End Sub
Mã:
Function InternetDateTime() As Double
Dim sTmp As String, sURL As String, FileName As String
Dim fso As Object, aTmp, Arr(1 To 2)
sURL = "http://www.timeanddate.com/worldclock/city.html?n=95"
Set fso = CreateObject("Scripting.FileSystemObject")
FileName = fso.GetTempName
DownloadFile sURL, FileName
With fso.OpenTextFile(FileName, 1)
sTmp = .ReadAll
.Close
End With
Set fso = Nothing: Kill (FileName)
sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))
sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</strong>") - 1)
sTmp = Mid(sTmp, InStr(1, sTmp, "big>") + 4)
aTmp = Split(sTmp, " at ")
Arr(2) = TimeValue(aTmp(1))
sTmp = Trim(Replace(aTmp(0), ",", ""))
aTmp = Split(sTmp, " ")
Arr(1) = DateValue(aTmp(2) & "-" & aTmp(1) & "-" & aTmp(3))
InternetDateTime = CLng(Arr(1)) + CDbl(Arr(2))
End Function
Mã:
Sub Main()
Dim sComm As String, sTime As String, sDate As String, sFormat As String
Dim dNow As Double
dNow = InternetDateTime
sTime = Format(dNow, "hh:mm:ss")
Select Case Application.International(xlDateOrder)
Case Is = 0: sFormat = "MM/dd/yyyy"
Case Is = 1: sFormat = "dd/MM/yyyy"
Case Is = 2: sFormat = "yyyy/MM/dd"
End Select
sDate = Format(dNow, sFormat)
sComm = "cmd.exe /c Time " & sTime
CreateObject("WScript.Shell").Run sComm, 0, True
sComm = "cmd.exe /c Date " & sDate
CreateObject("WScript.Shell").Run sComm, 0, True
End Sub
Chuyển Time Zone thành Bangkok, Hanoi, Jakarta nhé
Mã:
Sub VNTimeZone()
Dim sComm As String
sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time"""
CreateObject("WScript.Shell").Run sComm, 0, True
End Sub
Thí nghiệm chuyển bằng tay Time Zone trên máy tính thành "cái khác", xong chạy code xem thế nào nhé
---------------
Để việc đặt ngày giờ được chính xác, bạn phải chạy code VNTimeZone trước, xong mới chạy Sub Main nhé
Bạn có thể gộp 2 code làm 1 cũng với nguyên tắc: Set Time Zone trước khi Set Data Time
Ví dụ code gộp:
Mã:
Sub Main()
Dim sComm As String, sTime As String, sDate As String, sFormat As String
Dim dNow As Double
[COLOR=#ff0000][B]VNTimeZone[/B][/COLOR]
dNow = InternetDateTime
sTime = Format(dNow, "hh:mm:ss")
Select Case Application.International(xlDateOrder)
Case Is = 0: sFormat = "MM/dd/yyyy"
Case Is = 1: sFormat = "dd/MM/yyyy"
Case Is = 2: sFormat = "yyyy/MM/dd"
End Select
sDate = Format(dNow, sFormat)
sComm = "cmd.exe /c Time " & sTime
CreateObject("WScript.Shell").Run sComm, 0, True
sComm = "cmd.exe /c Date " & sDate
CreateObject("WScript.Shell").Run sComm, 0, True
End Sub
Tôi đang dùng 1 file Excel mà giá trị tính toán có dựa vào thời gian của hệ thống. Tuy nhiên một vài máy tính có thời gian chạy không đúng.
Vậy có Code nào để khi chạy mở file excel, Windows sẽ bị buộc phải cập nhật ngày giờ qua Internet Time Update.
Ngoài ra nếu được có thể tự chỉnh lại định dạng ngày tháng trong hệ thống không ?
Với DWORD SpecialPollInterval là thời gian (giây) máy tính của bạn sẽ nối với máy chủ time của Microsoft để cập nhật. Mặc định là 7 ngày tuy nhiên bạn còn thể chỉnh xuống tổi thiểu 1 giây.
Để sử dụng được tính năng này thì dịch vụ Windows Time phải đang chạy. Trên Windows 7 mình đang chạy, dịch vụ này có trạng thái Stopped. Bạn chuyển Startup style về Automatic.
2. Nếu hệ thống LAN của bạn có 1 máy tính cài đặt giờ chuẩn thì dùng 1 file BATCH dùng lệnh NET TIME rồi kẻo thả vào Startup (thực thi khi máy khởi động/login). Cái này không yêu cầu kết nối internet.
Nhìn có vẻ phức tạp nhưng thực hiện khá đơn giản đấy. Cách 1 có thể coi là chuẩn nhất vì bạn được cập nhật giờ của máy chủ Microsoft. Chỉ cần bạn đặt đúng Time Zone Hà Nội thì máy tính sẽ tự cập nhật giờ Hà Nội cho bạn.
Với DWORD SpecialPollInterval là thời gian (giây) máy tính của bạn sẽ nối với máy chủ time của Microsoft để cập nhật. Mặc định là 7 ngày tuy nhiên bạn còn thể chỉnh xuống tổi thiểu 1 giây.
Để sử dụng được tính năng này thì dịch vụ Windows Time phải đang chạy. Trên Windows 7 mình đang chạy, dịch vụ này có trạng thái Stopped. Bạn chuyển Startup style về Automatic.
2. Nếu hệ thống LAN của bạn có 1 máy tính cài đặt giờ chuẩn thì dùng 1 file BATCH dùng lệnh NET TIME đặt vào Startup (thực thi khi máy khởi động/login). Cái này không yêu cầu kết nối internet.
Nhìn có vẻ phức tạp nhưng thực hiện khá đơn giản đấy. Cách 1 có thể coi là chuẩn nhất vì bạn được cập nhật giờ của máy chủ Microsoft. Chỉ cần bạn đặt đúng Time Zone Hà Nội thì máy tính sẽ tự cập nhật giờ Hà Nội cho bạn.
Hi! Đây là cách giải quyết của người trình độ thấp sao bằng cách làm đẳng cấp của anh NDU được. Nhưng em nghĩ cái này là tính năng có sẵn, không cần cài đặt gì thêm. Của chùa mà không dùng thì tiếc quá.
Cái này cài 1 lần rồi nó tự chạy dài. Cứ login windows cái là nó chạy. Với cách 1 thì cứ sau n giây thì nó tự chạy. Không phải kích hoạt gì cả.
Thời gian được điều chỉnh theo Time Zone của bạn. Bạn cài time zone Hà Nội, thì nó tự nhận biết Hà Nội, Singapore thì tự nhận biết là Singapore, Lodon tự biết là London... Giống kiểu nhập gia tùy tục.
Chưa kể WindowsTime được Microsoft cung cấp ổn định hơn 12 năm nay trong khi các dịch vụ khác có thời gian hoạt động ít hơn và có thể bị thay đổi hoặc kết thúc không báo trước.
Cái này cài 1 lần rồi nó tự chạy dài. Cứ login windows cái là nó chạy. Với cách 1 thì cứ sau n giây thì nó tự chạy. Không phải kích hoạt gì cả.
Cái này là phần cài đặt cho Regedit. Thời gian mỗi lần tự cập nhật là 24h.
SpecialPollInterval (dword):00015180
Tiếc là GPE không cho up file REG.
Theo như tôi hiểu thì tác giả đang viết 1 code gì đó và đưa cho người khác xài (không phải xài trên máy mình).. Code này có tính toán gì đó liên quan đến thời gian thực nên buộc phải viết luôn trong code để dù người ta có cố tình chỉnh lại ngày giờ thì code vẫn nhận biết được
Vậy bạn nghĩ xem, liệu có phải nên khuyên tác giả rằng: Trước khi đưa code cho ai đó thì nên chịu khó ngồi vào máy đó chỉnh lại registry?
Dù chỉ chỉnh có 1 lần thì không phải vẫn mất công sao? Tôi ở Biên Hòa, bạn ấy ở Hà Nội, phải bay vào Nam để chỉnh chắc?
Còn nếu như viết code để làm vụ này (không phải ngồi vào máy người ta) thì vẫn như tôi nói ở trên: Độ phức tạp của code là như nhau
1. Dùng tính năng tự động cập nhật giờ của Windows. Tính năng này xuất hiện ít nhất là từ Windows XP.
2. Nếu hệ thống LAN của bạn có 1 máy tính cài đặt giờ chuẩn thì dùng 1 file BATCH dùng lệnh NET TIME rồi kẻo thả vào Startup (thực thi khi máy khởi động/login). Cái này không yêu cầu kết nối internet.
Nhìn có vẻ phức tạp nhưng thực hiện khá đơn giản đấy. Cách 1 có thể coi là chuẩn nhất vì bạn được cập nhật giờ của máy chủ Microsoft. Chỉ cần bạn đặt đúng Time Zone Hà Nội thì máy tính sẽ tự cập nhật giờ Hà Nội cho bạn.
Bạn ơi, để update thời gian cho máy (Windows) bằng tay thì tôi đã biết từ năm 2011 khi WinXP giới thiệu bản dùng thử. Vấn để là file Excel được nhiều người sử dụng, chẳng lẽ mình nhắc từng người để họ Update thời gian, (hoặc gửi cho họ file .reg). Với lại nhiều máy chỗ tôi luôn luôn có thời gian không chuẩn, (chắc do yếu pin CMOS).
Sản phẩm phần mềm tốt khi chạy cần kiểm tra một vài thông số và tự động điều chỉnh nếu cần để giảm bớt thao tác cho người dùng.
Cảm ơn bác NDU, dùng file của bác em thấy kết quả update nhanh hơn khi nhấn nút Update Now.
Chuyển Time Zone thành Bangkok, Hanoi, Jakarta nhé
Mã:
Sub VNTimeZone()
Dim sComm As String
sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time"""
CreateObject("WScript.Shell").Run sComm, 0, True
End Sub
Thí nghiệm chuyển bằng tay Time Zone trên máy tính thành "cái khác", xong chạy code xem thế nào nhé
---------------
Để việc đặt ngày giờ được chính xác, bạn phải chạy code VNTimeZone trước, xong mới chạy Sub Main nhé
Bạn có thể gộp 2 code làm 1 cũng với nguyên tắc: Set Time Zone trước khi Set Data Time
Ví dụ code gộp:
Mã:
Sub Main()
Dim sComm As String, sTime As String, sDate As String, sFormat As String
Dim dNow As Double
[COLOR=#ff0000][B]VNTimeZone[/B][/COLOR]
dNow = InternetDateTime
sTime = Format(dNow, "hh:mm:ss")
Select Case Application.International(xlDateOrder)
Case Is = 0: sFormat = "MM/dd/yyyy"
Case Is = 1: sFormat = "dd/MM/yyyy"
Case Is = 2: sFormat = "yyyy/MM/dd"
End Select
sDate = Format(dNow, sFormat)
sComm = "cmd.exe /c Time " & sTime
CreateObject("WScript.Shell").Run sComm, 0, True
sComm = "cmd.exe /c Date " & sDate
CreateObject("WScript.Shell").Run sComm, 0, True
End Sub
Chính xác là vậy!
Riêng với Windows XP em không biết có cách nào không? Theo anh thì dùng cái gì đây?
(Trong Registry em biết đường dẫn nhưng cũng không biết thay đổi thế nào cho đúng)
Quả là các anh/chị toàn dùng cách cao siêu. Bái phục bái phục...
Mình thì hồi trước hay máy mó mấy cái tính năng trong Windows. Nội nguyên cái thư mục Windows cũng cả trăm chương trình mà chả thấy sách báo nào nói tới.
Cách NET TIME thì đúng lạc hậu quá rồi (chắc có từ thế kỷ trước). Còn cách Windows-Time tốn 10 phút search và thử. Nút thắt là vấn đề bật cái service time. Lâu lắm rồi mới có dịp mò ra 1 cái tính năng mới (cũ người mới ta). Với mình thì vậy là nhanh còn với các sư phụ đây chắc giải quyết nhanh hơn nhiều.
Nói chung là không đủ trình độ viết code này nọ thì đành phải chịu khó thử và search vậy.
Cách NET TIME thì đúng lạc hậu quá rồi (chắc có từ thế kỷ trước). Còn cách Windows-Time tốn 10 phút search và thử. Nút thắt là vấn đề bật cái service time. Lâu lắm rồi mới có dịp mò ra 1 cái tính năng mới (cũ người mới ta). Với mình thì vậy là nhanh còn với các sư phụ đây chắc giải quyết nhanh hơn nhiều.
Nói chung là không đủ trình độ viết code này nọ thì đành phải chịu khó thử và search vậy.
Đâu có đâu! NET TIME không lạc hậu... Mà nói chung thì chẳng cái gì lạc hậu cả, vấn đề là ta dùng nó thế nào thôi! Tôi vẫn dùng DOS trong VBA (bạn thấy trong code đấy thôi) mà chẳng thấy có gì lạc hậu cả
Tức là: Cái gì giúp ta giải quyết tốt vấn đề thì cái ấy.. ngon
Ẹc... Ẹc...
Chính xác là vậy!
Riêng với Windows XP em không biết có cách nào không? Theo anh thì dùng cái gì đây?
(Trong Registry em biết đường dẫn nhưng cũng không biết thay đổi thế nào cho đúng)
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName As String * 64 ' (0 To 31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName As String * 64 ' (0 To 31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Type REG_TIME_ZONE_INFORMATION
Bias As Long
StandardBias As Long
DaylightBias As Long
StandardDate As SYSTEMTIME
DaylightDate As SYSTEMTIME
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32.dll" (ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SetTimeZoneInformation Lib "kernel32.dll" (ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SetLocalTime Lib "kernel32.dll" (ByRef lpSystemTime As SYSTEMTIME) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Sub SetTimeZone(ByVal TimeZone As String)
Dim hkey As Long, lpType As Long, lpcbData As Long
Dim TZI As TIME_ZONE_INFORMATION, RTZI As REG_TIME_ZONE_INFORMATION
If RegOpenKeyEx(HKLM, TimeZonesKey & TimeZone, 0, KEY_ALL_ACCESS, hkey) <> ERROR_SUCCESS Then Exit Sub
lpType = REG_BINARY
lpcbData = Len(RTZI)
If RegQueryValueEx(hkey, "TZI", 0, lpType, RTZI, lpcbData) <> ERROR_SUCCESS Then Exit Sub
lpType = REG_SZ
lpcbData = Len(TZI.StandardName)
If RegQueryValueExStr(hkey, "Std", 0, lpType, TZI.StandardName, lpcbData) <> ERROR_SUCCESS Then Exit Sub
lpcbData = Len(TZI.DaylightName)
If RegQueryValueExStr(hkey, "Dlt", 0, lpType, TZI.DaylightName, lpcbData) <> ERROR_SUCCESS Then Exit Sub
RegCloseKey hkey
Sub SetLocalDateTime(ByVal Year As Integer, ByVal Month As Integer, ByVal Day As Integer, _
ByVal Hour As Integer, ByVal Minute As Integer, ByVal Second As Integer)
Dim st As SYSTEMTIME
With st
.wYear = Year
.wMonth = Month
.wDay = Day
.wHour = Hour
.wMinute = Minute
.wSecond = Second
End With
SetLocalTime st
End Sub
Sub Button1_Click()
SetTimeZone "SE Asia Standard Time"
SetLocalDateTime 2013, 2, 25, 16, 30, 25
End Sub
[/GPECODE]
