Dùng VBA để hẹn giờ đóng file excel

dangtaipbtn · 1/12/18

chào các bác, hiện tại em đang cần 1 code VBA hẹn giờ đóng file nếu file không sử dụng ạ. mong các bác giúp đỡ

Hoàng Nhật Phương · 1/12/18

dangtaipbtn đã viết:
chào các bác, hiện tại em đang cần 1 code VBA hẹn giờ đóng file nếu file không sử dụng ạ. mong các bác giúp đỡ

Bạn thử nhé:
https://stackoverflow.com/questions/34908387/automatically-close-workbook-after-inactivity
This Workbook module:

Mã:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    stop_Countdown
ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    start_Countdown
    End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    stop_Countdown
    start_Countdown
    End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    stop_Countdown
    start_Countdown
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    stop_Countdown
    start_Countdown
End Sub

Regular Module:

Mã:

Option Explicit

Public Close_Time As Date

Sub start_Countdown()

    Close_Time = Now() + TimeValue("00:00:10")

    Application.OnTime Close_Time, "close_WB"

    End Sub

Sub stop_Countdown()

    Application.OnTime Close_Time, "close_WB", , False

    End Sub

Sub close_wb()

    ThisWorkbook.Close True

    End Sub

Hoặc:
https://www.giaiphapexcel.com/diendan/threads/hẹn-giờ-tắt-mở-file-excel.123761/

dangtaipbtn · 3/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Bạn thử nhé:
https://stackoverflow.com/questions/34908387/automatically-close-workbook-after-inactivity
This Workbook module:

Mã:

Private Sub Workbook_BeforeClose(Cancel As Boolean) stop_Countdown ThisWorkbook.Save End Sub Private Sub Workbook_Open() start_Countdown End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) stop_Countdown start_Countdown End Sub Private Sub Workbook_SheetCalculate(ByVal Sh As Object) stop_Countdown start_Countdown End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _ ByVal Target As Excel.Range) stop_Countdown start_Countdown End Sub

Regular Module:

Mã:

Option Explicit Public Close_Time As Date Sub start_Countdown() Close_Time = Now() + TimeValue("00:00:10") Application.OnTime Close_Time, "close_WB" End Sub Sub stop_Countdown() Application.OnTime Close_Time, "close_WB", , False End Sub Sub close_wb() ThisWorkbook.Close True End Sub

Hoặc:
https://www.giaiphapexcel.com/diendan/threads/hẹn-giờ-tắt-mở-file-excel.123761/[/

cảm ơn chị gái nhưng VBA của em báo lỗi

dangtaipbtn · 5/12/18

em cám ơn các bác nhé. em làm được rồi !

HeSanbi · 5/12/18

Nguyễn Hoàng Oanh Thơ đã viết:

Bạn thử nhé:
https://stackoverflow.com/questions/34908387/automatically-close-workbook-after-inactivity
This Workbook module:

Mã:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    stop_Countdown
ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    start_Countdown
    End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    stop_Countdown
    start_Countdown
    End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    stop_Countdown
    start_Countdown
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    stop_Countdown
    start_Countdown
End Sub

Regular Module:

Mã:

Option Explicit

Public Close_Time As Date

Sub start_Countdown()

    Close_Time = Now() + TimeValue("00:00:10")

    Application.OnTime Close_Time, "close_WB"

    End Sub

Sub stop_Countdown()

    Application.OnTime Close_Time, "close_WB", , False

    End Sub

Sub close_wb()

    ThisWorkbook.Close True

    End Sub

Hoặc:
https://www.giaiphapexcel.com/diendan/threads/hẹn-giờ-tắt-mở-file-excel.123761/

--> @Nguyễn Hoàng Oanh Thơ
Có ý tưởng này cho OT làm cho chủ topic.
- Sửa Sub có thể thay đổi thời gian Countdown. Ví dụ: Nhập vào 3000 giây
- Đóng Excel ! Nhở mà File mới vừa tạo chưa lưu vào đâu cả. Thì File vẫn sẽ mở
------ThisWorkbook.Close False thì sẽ mất File
- File chuẩn bị đóng thì hiện lên thông báo "Close OK?" trong vòng 1 phút không ấn gì cả / Yes thì đóng
- Thêm một Boolean nếu True thì close + tắt máy tính.

Hoàng Nhật Phương · 5/12/18

HeSanbi đã viết:
--> @Nguyễn Hoàng Oanh Thơ
Có ý tưởng này cho OT làm cho chủ topic.
- Sửa Sub có thể thay đổi thời gian Countdown. Ví dụ: Nhập vào 3000 giây
- Đóng Excel ! Nhở mà File mới vừa tạo chưa lưu vào đâu cả. Thì File vẫn sẽ mở
------ThisWorkbook.Close False thì sẽ mất File
- File chuẩn bị đóng thì hiện lên thông báo "Close OK?" trong vòng 1 phút không ấn gì cả / Yes thì đóng
- Thêm một Boolean nếu True thì close + tắt máy tính.

Xin chào HeSanbi,

Xin lỗi vì đầu tháng công việc của OT có phần bận rộn nên chưa thông tin đến bạn được.
Đề nghị của bạn thực sự với kiến thức hiện giờ của OT thì chưa thể làm được (vì hiện giờ OT mới chỉ tìm hiểu về code liên quan đến trích lọc,tổng hợp dữ liệu) mục đích để làm sao ứng dụng được vào nhu cầu thực tế trong công việc.
Vì thế mà các vấn đề liên quan đến thủ thuật gì đó OT chưa có nhu cầu tìm hiểu , nhưng sau khoảng một tuần nữa khi giải quyết xong một đống báo cáo đầu tháng thì OT sẽ quay lại tìm hiểu ạ.

Rất mong lúc đó sẽ nhận được thêm nhiều sự giúp đỡ , góp ý của bạn
Cảm ơn HeSanbi đã quan tâm.

dangtaipbtn · 5/12/18

chào bác. em muốn đóng thành khu giờ nhất định thì sửa code như nào cho đúng. 6h00 14h00 và 22h00

Bài đã được tự động gộp: 5/12/18

HeSanbi đã viết:
--> @Nguyễn Hoàng Oanh Thơ
Có ý tưởng này cho OT làm cho chủ topic.
- Sửa Sub có thể thay đổi thời gian Countdown. Ví dụ: Nhập vào 3000 giây
- Đóng Excel ! Nhở mà File mới vừa tạo chưa lưu vào đâu cả. Thì File vẫn sẽ mở
------ThisWorkbook.Close False thì sẽ mất File
- File chuẩn bị đóng thì hiện lên thông báo "Close OK?" trong vòng 1 phút không ấn gì cả / Yes thì đóng
- Thêm một Boolean nếu True thì close + tắt máy tính.

bác ơi. ý tưởng tắt máy không ổn lắm em chỉ cần tắt file thôi

HeSanbi · 5/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào HeSanbi,

Xin lỗi vì đầu tháng công việc của OT có phần bận rộn nên chưa thông tin đến bạn được.
Đề nghị của bạn thực sự với kiến thức hiện giờ của OT thì chưa thể làm được (vì hiện giờ OT mới chỉ tìm hiểu về code liên quan đến trích lọc,tổng hợp dữ liệu) mục đích để làm sao ứng dụng được vào nhu cầu thực tế trong công việc.
Vì thế mà các vấn đề liên quan đến thủ thuật gì đó OT chưa có nhu cầu tìm hiểu , nhưng sau khoảng một tuần nữa khi giải quyết xong một đống báo cáo đầu tháng thì OT sẽ quay lại tìm hiểu ạ.

Rất mong lúc đó sẽ nhận được thêm nhiều sự giúp đỡ , góp ý của bạn
Cảm ơn HeSanbi đã quan tâm.

Vậy OT lấy code này đi
- Có thời gian RunWhen
- Đóng Excel ! Nhở mà File mới vừa tạo chưa lưu vào đâu cả
- File chuẩn bị đóng thì hiện lên thông báo "Close OK?" trong vòng 1 phút không ấn gì cả / Yes thì đóng
- Thêm một Boolean nếu True thì close + tắt máy tính: Tham khảo tắt máy tính

dangtaipbtn đã viết:
bác ơi. ý tưởng tắt máy không ổn lắm em chỉ cần tắt file thôi

Có lúc cần đấy

Copy Module:

PHP:

Option Explicit
#If VBA7 Then
  Public Declare PtrSafe Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" ( _
    ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, _
    ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long
#Else
  Public Declare Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" ( _
    ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, _
    ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long
#End If

Public Close_Time As Date
Sub start_Countdown()
  Close_Time = Now() + setRunWhen(Secs:=3000)
  Application.OnTime Close_Time, "close_WB"
End Sub
Sub stop_Countdown()
  On Error Resume Next
  Application.OnTime Close_Time, "close_WB", , False
End Sub
Sub close_wb()
  If ActiveWorkbook.Path = "" Then
    Application.ActiveWorkbook.SaveAs Filename:="D:\Excel\File_Temp" & Format(Now(), "yyyy-mm-dd_hh_mm")  &".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
  Else
    ThisWorkbook.save
  End If
  Dim QT
  QT = MsgBoxTimeout(0, "Close OK?", "Alert", vbYesNo, 0, 60000)
  If QT = vbNo Then Exit Sub
  Call MsgBoxTimeout(0, "Close Now", "Alert", vbOKOnly, 0, 1000)
  Application.DisplayAlerts = False
    Application.Quit
    ActiveWorkbook.Close SaveChanges:=False
  Application.DisplayAlerts = True
End Sub
Sub test_()
  Debug.Print Format(setRunWhen(Secs:=600), "hh:mm:ss")
  Debug.Print Format(setRunWhen(Secs:=600) + Now(), "hh:mm:ss")

End Sub
  Function setRunWhen(Optional ByVal Hours As Long = 0, _
                      Optional ByVal Mins As Long = 0, _
                      Optional ByVal Secs As Long = 30) As Date
        If Secs = 0 And Mins = 0 And Hours = 0 Then Secs = 30
        If Mins = 0 And Hours = 0 And Secs > 59 Then
          Mins = Secs / 60
          Secs = Secs Mod 60
          Hours = IIf(Mins > 59, Mins / 60, 0)
        End If
        setRunWhen = TimeSerial(IIf(Hours > 23, 23, IIf(Hours < 0, 0, Hours)), _
                                        IIf(Mins > 59, 59, IIf(Mins < 0, 0, Mins)), _
                                        IIf(Secs > 59, 59, IIf(Secs < 0, 0, Secs)))
   
  End Function

Code Event Workbook:

PHP:

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    stop_Countdown
    'ThisWorkbook.save
End Sub
Private Sub Workbook_Open()
    start_Countdown
    End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    stop_Countdown
    start_Countdown
    End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    stop_Countdown
    start_Countdown
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    stop_Countdown
    start_Countdown
End Sub

----------------------------------------------------------------------
Kiểm thử kết quả Mảng trong Immediate với hàm dbPrint

tranchautrungduong · 3/3/19

Nguyễn Hoàng Oanh Thơ đã viết:

Bạn thử nhé:
https://stackoverflow.com/questions/34908387/automatically-close-workbook-after-inactivity
This Workbook module:

Mã:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    stop_Countdown
ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    start_Countdown
    End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    stop_Countdown
    start_Countdown
    End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    stop_Countdown
    start_Countdown
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    stop_Countdown
    start_Countdown
End Sub

Regular Module:

Mã:

Option Explicit

Public Close_Time As Date

Sub start_Countdown()

    Close_Time = Now() + TimeValue("00:00:10")

    Application.OnTime Close_Time, "close_WB"

    End Sub

Sub stop_Countdown()

    Application.OnTime Close_Time, "close_WB", , False

    End Sub

Sub close_wb()

    ThisWorkbook.Close True

    End Sub

Hoặc:
https://www.giaiphapexcel.com/diendan/threads/hẹn-giờ-tắt-mở-file-excel.123761/

Cái này không hoạt động khi ta sử dụng userform . tức ta mở userform đang gõ dữ liệu đến tg nó vẫn off file.

HeSanbi · 3/3/19

tranchautrungduong đã viết:
Cái này không hoạt động khi ta sử dụng userform . tức ta mở userform đang gõ dữ liệu đến tg nó vẫn off file.

Thì bạn viết thêm vài đoạn code nữa để làm được điều đó.
Rất nhiều cách

Dùng VBA để hẹn giờ đóng file excel

dangtaipbtn

Thành viên mới

Hoàng Nhật Phương

Thành viên gắn bó

dangtaipbtn

Thành viên mới

dangtaipbtn

Thành viên mới

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Hoàng Nhật Phương

Thành viên gắn bó

dangtaipbtn

Thành viên mới

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

tranchautrungduong

Thành viên chính thức

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

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

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

Đếm ngược thời gian