Bạn thử dùng code này
Sub auto_open()
On Error Resume Next
Dim myDate As Date
Dim Ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myDate = Date
If Sheets("Userlog").Range("a1").Value <= myDate Then [COLOR=darkgreen]'A1 là ngày kết thúc[/COLOR]
MsgBox "File nay khong mo duoc vi qua han su dung." & vbNewLine _
& "Vui long goi dien thoai cho tui", vbExclamation, "Thong bao"
ThisWorkbook.Close
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
ng = Day(Date)
th = Month(Date)
nam = Year(Date)
If ng > 1 And th > 5 And nam >= 2008 Then
tb = "This program have any problems for used." + Chr(10) + Chr(13)
tb = tb + "Please close and save avoid to lose data." + Chr(10) + Chr(13)
tb = tb + "Sorry very much !"
MsgBox (tb)
ActiveWorkbook.Save
Application.Quit
End If
End Sub
Thêm 1 phương án phụ là đếm số lần mở file ----> Khi ấy code sẽ xét 2 trường hợp Date > Giới hạn hoặc Số lần mở file > giới hạn thì sẽ đóng file, thậm chí xóa file mất xác luôn (điều kiện nào đến trước thì lấy)
[COLOR=blue]Private Sub Workbook_Open()[/COLOR]
Range("[COLOR=red]Sheet1!A1[/COLOR]").Value = Range("Sheet1!A1").Value + 1 'Dung de luu so lan mo file
If Range("[COLOR=red]Sheet1!A2[/COLOR]").Value = 1 Then
'Range("[COLOR=red]Sheet1!B2[/COLOR]").Value = DateSerial(Year(Now()), Month(Now()), Day(Now())) 'Chi ghi vao ngay, thang, nam thoi!
Range("[COLOR=red]Sheet1!B2[/COLOR]").Value = Now() 'Ghi day du thoi gian mo lan dau
ElseIf Round((Now() - Range("Sheet1!B2").Value), 0) [COLOR=red]>= 30[/COLOR] Or Range("[COLOR=red]Sheet1!A1[/COLOR]").Value [COLOR=red]> 10[/COLOR] Then 'Khi du 30 ngay hoac qua 10 lan thi se het han
Call [COLOR=magenta]Hethan[/COLOR]
End If
End Sub
[COLOR=blue]Private Sub Workbook_BeforeClose(Cancel As Boolean)[/COLOR]
Me.Save
End SubSub [COLOR=magenta]hethan[/COLOR]()
MsgBox ("Chuong trinh het han!")
Application.DisplayAlerts = False
ThisWorkbook.Close
End Sub
Private Sub Workbook_Open()
Dim fs, f, s
Dim tb As String
Application.Visible = False
tep = ThisWorkbook.Name
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(tep)
s = f.DateCreated + 1 / 96
If Now() > s Then
tb = "File nay da qua han test, de co the test ban copy file nay" & Chr(13) & _
"thanh ban copy khac de test hoac goi cho so 123456789. Cam on!"
MsgBox tb, , "TEST KHONG CHE THOI GIAN"
Application.Quit
Else
tb = "File nay chi mo duoc trong thoi gian 15 phut. Qua han de co the test" & Chr(13) & _
"ban copy file nay thanh ban copy khac de test hoac goi cho so 123456789. Cam on!"
MsgBox tb, , "TEST KHONG CHE THOI GIAN"
Application.Visible = True
End If
End SubEm thử file này cũng không được anh à ---> Mở lên, nó báo lổi và thoát luôn
Anh ơi... em nghĩ giải pháp này hay hơn: Số giờ mà ta hạn chế phải tính là số giờ người ta dùng file chứ ... Ví dụ anh hạn chế trong 1 giờ, vậy khi em mở file 15 phút rồi đóng lại thì vẫn tính 15 phút thôi... Sau đó em mở file này thêm 30 phút nữa thì cộng dồn vào là 45 phút sử dụng
Bạn tham khảo code lấy các thông số về file nhé. (Trong Help của Exc có đủ cả)
Sub ShowFileAccessInfo()
Dim fs, f, s
filespec = ThisWorkbook.path & "\" & ThisWorkbook.Name
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = "Ten file: " & f.Name & vbCrLf
s = s & "O dia: " & UCase(f.Drive) & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
MsgBox s, 0, "File Access Info"
End Sub
