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

giang140387

Thành viên mới
Tham gia ngày
2 Tháng mười hai 2013
Bài viết
21
Được thích
0
Điểm
363
Tuổi
32
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:

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!
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:

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,196
Được thích
1,093
Điểm
560
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
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,894
Được thích
9,236
Điểm
560
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..."
 

giang140387

Thành viên mới
Tham gia ngày
2 Tháng mười hai 2013
Bài viết
21
Được thích
0
Điểm
363
Tuổi
32
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
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
 
Top Bottom