Tự động thoát file excel sau 1 khoảng thời gian không thao tác

Liên hệ QC
G

giang140387

Thành viên mới
Tham gia
2/12/13
Bài viết
21
Được thích
0
Tình hình là phòng mình có 1 file share cả phòng dùng chung. Khi người trước sử dụng xong nhưng quên không thoát file dẫn đến tình trạng người sau không thể mở file để nhập dữ liệu được.
Các bạn có thể giúp mình đoạn code tự động thoát file sau 1 khoảng thời gian không thao tác nữa được ko ạ.

Xin cám ơn!
Bài đã được tự động gộp:

giang140387 đã viết:
Tình hình là phòng mình có 1 file share cả phòng dùng chung. Khi người trước sử dụng xong nhưng quên không thoát file dẫn đến tình trạng người sau không thể mở file để nhập dữ liệu được.
Các bạn có thể giúp mình đoạn code tự động thoát file sau 1 khoảng thời gian không thao tác nữa được ko ạ.

Xin cám ơn!
Nhấp chuột vào đây để mở rộng...
Mình có tìm 1 số code để thử nhưng chỉ làm được sau 1 khoảng thời gian thì tự thoát chứ không thể tính từ lần thao tác cuối cùng.
Nhờ các cao nhân giúp đỡ
Xin cám ơn
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn copy đoạn này vào code của Workbook:

------
PHP: 
Private TimeToClose As Date
Private Const MinuteToClose = 10
Private Sub Workbook_Activate()
  Call WaitForClose
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_Deactivate()
  Call WaitForClose
End Sub

Private Sub Workbook_NewChart(ByVal Ch As Chart)
  Call WaitForClose
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_Open()
  Call WaitForClose
End Sub

Private Sub Workbook_PivotTableCloseConnection(ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_PivotTableOpenConnection(ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_RowsetComplete(ByVal Description As String, ByVal Sheet As String, ByVal Success As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableAfterValueChange(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableBeforeAllocateChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableBeforeCommitChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableBeforeDiscardChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Object, ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Call WaitForClose
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
  Call WaitForClose
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
  Call WaitForClose
End Sub

Private Sub Workbook_WindowResize(ByVal Wn As Window)
  Call WaitForClose
End Sub
Private Sub WaitForClose()
  On Error Resume Next
  Application.OnTime TimeToClose, "'" & Application.ThisWorkbook.Name & "'!" & Application.ThisWorkbook.CodeName & ".CloseThisBook", , False
  TimeToClose = Now + TimeSerial(0, MinuteToClose, 0)
  Application.OnTime TimeToClose, "'" & Application.ThisWorkbook.Name & "'!" & Application.ThisWorkbook.CodeName & ".CloseThisBook", , True
End Sub
Private Sub CloseThisBook()
  On Error Resume Next
  ThisWorkbook.Close True
End Sub
 
Upvote 0
Vài bữa sau sẽ có người hỏi xin đoạn code "chống bị thoát ra sau một khoảng thời gian..."
 
Upvote 0
HeSanbi đã viết:
Bạn copy đoạn này vào code của Workbook:

------
PHP: 
Private TimeToClose As Date
Private Const MinuteToClose = 10
Private Sub Workbook_Activate()
  Call WaitForClose
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_Deactivate()
  Call WaitForClose
End Sub

Private Sub Workbook_NewChart(ByVal Ch As Chart)
  Call WaitForClose
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_Open()
  Call WaitForClose
End Sub

Private Sub Workbook_PivotTableCloseConnection(ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_PivotTableOpenConnection(ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_RowsetComplete(ByVal Description As String, ByVal Sheet As String, ByVal Success As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableAfterValueChange(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableBeforeAllocateChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableBeforeCommitChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableBeforeDiscardChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Object, ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
  Call WaitForClose
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Call WaitForClose
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
  Call WaitForClose
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
  Call WaitForClose
End Sub

Private Sub Workbook_WindowResize(ByVal Wn As Window)
  Call WaitForClose
End Sub
Private Sub WaitForClose()
  On Error Resume Next
  Application.OnTime TimeToClose, "'" & Application.ThisWorkbook.Name & "'!" & Application.ThisWorkbook.CodeName & ".CloseThisBook", , False
  TimeToClose = Now + TimeSerial(0, MinuteToClose, 0)
  Application.OnTime TimeToClose, "'" & Application.ThisWorkbook.Name & "'!" & Application.ThisWorkbook.CodeName & ".CloseThisBook", , True
End Sub
Private Sub CloseThisBook()
  On Error Resume Next
  ThisWorkbook.Close True
End Sub
Nhấp chuột vào đây để mở rộng...

Cám ơn bạn rất nhiều. Để mình test thử.
Bạn cho mình hỏi thêm cái này với. Nếu mình gôm hết tất cả private sub của workbook đổi thành sheet_selectchange thì có thiếu gì ko bạn. Xin cám ơn
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

phanngoctrai1981
  • Question
Tính trung bình theo các nhóm bằng VBA
Trả lời
2
Đọc
21
phanngoctrai1981
phanngoctrai1981
T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
14
Đọc
178
tsslump
T
N
Xin code tính tổng số cấu đúng viết trong "Visual Basic" trong PPT
Trả lời
2
Đọc
4K
snow25
snow25
T
  • Question
Ghép 2 cột dữ liệu
Trả lời
2
Đọc
27
snow25
snow25
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
11
Đọc
211
giaiphap
giaiphap
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom