Thoát tất cả Sub trong VBA

Liên hệ QC
Trần_Minh_5695

Trần_Minh_5695

Thành viên mới
Tham gia
27/9/21
Bài viết
34
Được thích
4
Cho e hỏi có code nào để mình thoát tất cả các Sub đang chạy ngầm trong VBA ko ạ?
Em tìm trên mạng code để AutoSave file excel sau 1 phút, nhưg khi tắt file đi => Sau 1 phút thì file lại tự bật lại để save do chạy code.
Em có thử hàm Exit Sub trong event Workbook_BeforeClose nhưg ko đc.
Mong mn giúp đỡ!
(Có file đính kèm)

1653444806786.png

1653444682302.png
 

File đính kèm

  • Material_Controll.xlsm
    108.9 KB · Đọc: 15
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn có thể tham khảo hai cách đơn giản sau:

Cách 1: Tạo biến lưu trữ thời gian sẽ gọi hàm
Public OnTimeProc As Date

OnTimeProc = VBA.Now + TimeSerial(0,1,0)
Application.Ontime OnTimeProc, "Auto_Save"

Và Thoát, đặt mã thoát vào Workbook Close:
Application.Ontime OnTimeProc, "Auto_Save", , False

Cách 2: Lưu trữ vào một Dictionary, cách này dành cho dự án lớn
AOT2 TimeSerial(0,1,0), "Auto_Save"

Gọi OnTimeStopAll từ Workbook Close

JavaScript: 
Private dAllOnTime As Object
Sub AOTCallback(procedure$)
  On Error Resume Next
  dAllOnTime.Remove procedure
  AOT2 , procedure, True
End Sub
Sub AOT2(Optional time As Date, Optional Proc$, Optional ByVal Schedule As Boolean = True)
  If dAllOnTime Is Nothing Then
    Set dAllOnTime = VBA.CreateObject("Scripting.Dictionary")
    dAllOnTime.CompareMode = 1
  End If
  On Error Resume Next
  If Not Schedule Then
    time = dAllOnTime(Proc)
    GoSub e
    dAllOnTime.Remove Proc
  Else
    If time < VBA.Now() Then
      time = VBA.Now() + time
    End If
    GoSub e
    dAllOnTime(Proc) = time
  End If
Exit Sub
e:
  'Debug.Print Schedule, onProject(Proc)
  Application.OnTime time, onProject(Proc), , Schedule
Return
End Sub

Sub OnTimeStopAll()
  On Error Resume Next
  If dAllOnTime Is Nothing Then
    Exit Sub
  End If
  Dim k
  For Each k In dAllOnTime.Keys()
    AOT2 dAllOnTime(k), CStr(k), False
  Next
  dAllOnTime.RemoveAll
  Set dAllOnTime = Nothing
End Sub
Function onProject(ByVal procedure As String, Optional ByVal Style As String = "") As String
  ' OnTime: 'Procedure 1'
  ' OnAction: Procedure (1)
  ' AssignMacro: Procedure (1)
  If procedure Like "'*'!*" Then
    onProject = procedure
  Else
    If procedure Like "*)" Or Not procedure Like "* *" Then
      onProject = "'" & ThisWorkbook.Name & "'!" & procedure
    Else
      onProject = "'" & ThisWorkbook.Name & "'!'" & procedure & "'"
    End If
  End If
End Function
 
Upvote 0
HeSanbi đã viết:
Bạn có thể tham khảo hai cách đơn giản sau:

Cách 1: Tạo biến lưu trữ thời gian sẽ gọi hàm
Public OnTimeProc As Date

OnTimeProc = VBA.Now + TimeSerial(0,1,0)
Application.Ontime OnTimeProc, "Auto_Save"

Và Thoát, đặt mã thoát vào Workbook Close:
Application.Ontime OnTimeProc, "Auto_Save", , False

Cách 2: Lưu trữ vào một Dictionary, cách này dành cho dự án lớn
AOT2 TimeSerial(0,1,0), "Auto_Save"

Gọi OnTimeStopAll từ Workbook Close

JavaScript: 
Private dAllOnTime As Object
Sub AOTCallback(procedure$)
  On Error Resume Next
  dAllOnTime.Remove procedure
  AOT2 , procedure, True
End Sub
Sub AOT2(Optional time As Date, Optional Proc$, Optional ByVal Schedule As Boolean = True)
  If dAllOnTime Is Nothing Then
    Set dAllOnTime = VBA.CreateObject("Scripting.Dictionary")
    dAllOnTime.CompareMode = 1
  End If
  On Error Resume Next
  If Not Schedule Then
    time = dAllOnTime(Proc)
    GoSub e
    dAllOnTime.Remove Proc
  Else
    If time < VBA.Now() Then
      time = VBA.Now() + time
    End If
    GoSub e
    dAllOnTime(Proc) = time
  End If
Exit Sub
e:
  'Debug.Print Schedule, onProject(Proc)
  Application.OnTime time, onProject(Proc), , Schedule
Return
End Sub

Sub OnTimeStopAll()
  On Error Resume Next
  If dAllOnTime Is Nothing Then
    Exit Sub
  End If
  Dim k
  For Each k In dAllOnTime.Keys()
    AOT2 dAllOnTime(k), CStr(k), False
  Next
  dAllOnTime.RemoveAll
  Set dAllOnTime = Nothing
End Sub
Function onProject(ByVal procedure As String, Optional ByVal Style As String = "") As String
  ' OnTime: 'Procedure 1'
  ' OnAction: Procedure (1)
  ' AssignMacro: Procedure (1)
  If procedure Like "'*'!*" Then
    onProject = procedure
  Else
    If procedure Like "*)" Or Not procedure Like "* *" Then
      onProject = "'" & ThisWorkbook.Name & "'!" & procedure
    Else
      onProject = "'" & ThisWorkbook.Name & "'!'" & procedure & "'"
    End If
  End If
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn!
Để mình thử :D
 
Upvote 0
HeSanbi đã viết:
Bạn có thể tham khảo hai cách đơn giản sau:

Cách 1: Tạo biến lưu trữ thời gian sẽ gọi hàm
Public OnTimeProc As Date

OnTimeProc = VBA.Now + TimeSerial(0,1,0)
Application.Ontime OnTimeProc, "Auto_Save"

Và Thoát, đặt mã thoát vào Workbook Close:
Application.Ontime OnTimeProc, "Auto_Save", , False

Cách 2: Lưu trữ vào một Dictionary, cách này dành cho dự án lớn
AOT2 TimeSerial(0,1,0), "Auto_Save"

Gọi OnTimeStopAll từ Workbook Close

JavaScript: 
Private dAllOnTime As Object
Sub AOTCallback(procedure$)
  On Error Resume Next
  dAllOnTime.Remove procedure
  AOT2 , procedure, True
End Sub
Sub AOT2(Optional time As Date, Optional Proc$, Optional ByVal Schedule As Boolean = True)
  If dAllOnTime Is Nothing Then
    Set dAllOnTime = VBA.CreateObject("Scripting.Dictionary")
    dAllOnTime.CompareMode = 1
  End If
  On Error Resume Next
  If Not Schedule Then
    time = dAllOnTime(Proc)
    GoSub e
    dAllOnTime.Remove Proc
  Else
    If time < VBA.Now() Then
      time = VBA.Now() + time
    End If
    GoSub e
    dAllOnTime(Proc) = time
  End If
Exit Sub
e:
  'Debug.Print Schedule, onProject(Proc)
  Application.OnTime time, onProject(Proc), , Schedule
Return
End Sub

Sub OnTimeStopAll()
  On Error Resume Next
  If dAllOnTime Is Nothing Then
    Exit Sub
  End If
  Dim k
  For Each k In dAllOnTime.Keys()
    AOT2 dAllOnTime(k), CStr(k), False
  Next
  dAllOnTime.RemoveAll
  Set dAllOnTime = Nothing
End Sub
Function onProject(ByVal procedure As String, Optional ByVal Style As String = "") As String
  ' OnTime: 'Procedure 1'
  ' OnAction: Procedure (1)
  ' AssignMacro: Procedure (1)
  If procedure Like "'*'!*" Then
    onProject = procedure
  Else
    If procedure Like "*)" Or Not procedure Like "* *" Then
      onProject = "'" & ThisWorkbook.Name & "'!" & procedure
    Else
      onProject = "'" & ThisWorkbook.Name & "'!'" & procedure & "'"
    End If
  End If
End Function
Nhấp chuột vào đây để mở rộng...
Mình có thử nhưg nó lại báo lỗi
1653447109132.png
 
Upvote 0
HeSanbi đã viết:
Bạn có thể tham khảo hai cách đơn giản sau:

Cách 1: Tạo biến lưu trữ thời gian sẽ gọi hàm
Public OnTimeProc As Date

OnTimeProc = VBA.Now + TimeSerial(0,1,0)
Application.Ontime OnTimeProc, "Auto_Save"

Và Thoát, đặt mã thoát vào Workbook Close:
Application.Ontime OnTimeProc, "Auto_Save", , False

Cách 2: Lưu trữ vào một Dictionary, cách này dành cho dự án lớn
AOT2 TimeSerial(0,1,0), "Auto_Save"

Gọi OnTimeStopAll từ Workbook Close

JavaScript: 
Private dAllOnTime As Object
Sub AOTCallback(procedure$)
  On Error Resume Next
  dAllOnTime.Remove procedure
  AOT2 , procedure, True
End Sub
Sub AOT2(Optional time As Date, Optional Proc$, Optional ByVal Schedule As Boolean = True)
  If dAllOnTime Is Nothing Then
    Set dAllOnTime = VBA.CreateObject("Scripting.Dictionary")
    dAllOnTime.CompareMode = 1
  End If
  On Error Resume Next
  If Not Schedule Then
    time = dAllOnTime(Proc)
    GoSub e
    dAllOnTime.Remove Proc
  Else
    If time < VBA.Now() Then
      time = VBA.Now() + time
    End If
    GoSub e
    dAllOnTime(Proc) = time
  End If
Exit Sub
e:
  'Debug.Print Schedule, onProject(Proc)
  Application.OnTime time, onProject(Proc), , Schedule
Return
End Sub

Sub OnTimeStopAll()
  On Error Resume Next
  If dAllOnTime Is Nothing Then
    Exit Sub
  End If
  Dim k
  For Each k In dAllOnTime.Keys()
    AOT2 dAllOnTime(k), CStr(k), False
  Next
  dAllOnTime.RemoveAll
  Set dAllOnTime = Nothing
End Sub
Function onProject(ByVal procedure As String, Optional ByVal Style As String = "") As String
  ' OnTime: 'Procedure 1'
  ' OnAction: Procedure (1)
  ' AssignMacro: Procedure (1)
  If procedure Like "'*'!*" Then
    onProject = procedure
  Else
    If procedure Like "*)" Or Not procedure Like "* *" Then
      onProject = "'" & ThisWorkbook.Name & "'!" & procedure
    Else
      onProject = "'" & ThisWorkbook.Name & "'!'" & procedure & "'"
    End If
  End If
End Function
Nhấp chuột vào đây để mở rộng...
Sao mình thử (Application.Ontime OnTimeProc, "Auto_Save", , False) không được bạn?
Mình có search trên mạng thì cũg có chỉ giốg vậy nhưg nó cứ báo lỗi :((
1653453798794.png

1653453777596.png
 
Upvote 0
Thớt thử code này (ở module), xóa hết code trong ThisWorkbook đi.
Mã: 
Dim dTime As Double
Sub Auto_Save()
    Application.DisplayAlerts = False
    ThisWorkbook.Save
    Application.DisplayAlerts = True
    SetSchedule
End Sub
Private Sub Auto_Open()
    SetSchedule
    'Material_Scan.Show
End Sub
Private Sub Auto_Close()
    Application.OnTime dTime, "Auto_Save", , False
End Sub
Private Sub SetSchedule()
    dTime = Now + TimeValue("00:01:00")
    Application.OnTime dTime, "Auto_Save"
End Sub
 
Upvote 0
huuthang_bd đã viết:
Thớt thử code này (ở module), xóa hết code trong ThisWorkbook đi.
Mã: 
Dim dTime As Double
Sub Auto_Save()
    Application.DisplayAlerts = False
    ThisWorkbook.Save
    Application.DisplayAlerts = True
    SetSchedule
End Sub
Private Sub Auto_Open()
    SetSchedule
    'Material_Scan.Show
End Sub
Private Sub Auto_Close()
    Application.OnTime dTime, "Auto_Save", , False
End Sub
Private Sub SetSchedule()
    dTime = Now + TimeValue("00:01:00")
    Application.OnTime dTime, "Auto_Save"
End Sub
Nhấp chuột vào đây để mở rộng...
Code ok r @@
Cho mình hỏi Sub Autopen() với Auto_Close() là mặc định chạy lúc mở/đóng file excel hay sao vậy?
 
Upvote 0
Trần_Minh_5695 đã viết:
Cho mình hỏi Sub Autopen() với Auto_Close() là mặc định chạy lúc mở/đóng file excel hay sao vậy?
Nhấp chuột vào đây để mở rộng...
Đúng vậy, Auto_ Open tương đương với Workbook_Open và Auto_Close tương đương với Workbook_BeforeClose. Tuy có một vài điểm khác biệt nhưng về cơ bản thì tương tự nhau, nếu bạn muốn tìm hiểu sâu hơn thì có thể tìm trên internet.
 
Upvote 0
huuthang_bd đã viết:
Đúng vậy, Auto_ Open tương đương với Workbook_Open và Auto_Close tương đương với Workbook_BeforeClose. Tuy có một vài điểm khác biệt nhưng về cơ bản thì tương tự nhau, nếu bạn muốn tìm hiểu sâu hơn thì có thể tìm trên internet.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn rất nhiều
Mình mới tìm được trên mạng :D

Julian's Excel Macro (VBA) Tips for Beginners

Home training in MS Applications such as Excel, Word, Powerpoint, Windows, FrontPage in PJ, KL, Malaysia
www.angelfire.com
 
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

thlpro
Truy Vấn Công thức từ Sheet này Qua Sheet Khác
Trả lời
6
Đọc
118
Hoàng Tuấn 868
H
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
614
GPE-Trợ Lý
GPE-Trợ Lý
N
  • Question
Làm ơn viết giùm mình macro làm tròn giá trị ạ
    • Cười
Trả lời
14
Đọc
99
ptm0412
ptm0412
S
Lý do công thức bị mờ tại ô Function
    • Cười
Trả lời
1
Đọc
21
ptm0412
ptm0412
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
8 9 10
Trả lời
191
Đọc
10K
ongke0711
ongke0711
CNKyNguyen
Giảm dung lượng của file excel
    • Cảm ơn
    • Cười
    • Thích
Trả lời
2
Đọc
226
CNKyNguyen
CNKyNguyen
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
9
Đọc
404
vostro 1500
vostro 1500
T
Xin trợ giúp code về dò tìm dữ liệu
Trả lời
0
Đọc
55
THU UYEN317
T
P
Sự cố về hàm SUMIF
Trả lời
8
Đọc
228
yeudoi
yeudoi
OverAC
Thông báo nội dung xấu và bài viết vi phạm nội quy.
19 20 21
Trả lời
416
Đọc
41K
vanle33
vanle33
S
Chuyển định dạng thời gian từ sa/ch sang AM/PM
Trả lời
2
Đọc
65
Silklynk
S
B
Sắp xếp lịch trực
5 6 7
Trả lời
130
Đọc
86K
TTVAN28
TTVAN28
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
4
Đọc
137
nguyenthieny
N
N
  • Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
2
Đọc
81
bebo021999
B
hoaithanh9480
Nhờ giúp đỡ về kiểm phiếu bầu
Trả lời
4
Đọc
100
hoaithanh9480
hoaithanh9480
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
2
Đọc
133
hoangtuaotrang_hp_vn
H
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
    • Yêu thích
Trả lời
1
Đọc
93
HUONGHCKT
H
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
14
Đọc
293
viethung78
V
N
cộng các dữ liệu không trùng nhau
Trả lời
13
Đọc
235
DeTong
D
T
Lỗi import dữ liệu
Trả lời
1
Đọc
53
ongke0711
ongke0711
Xem thêm…

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