انتقل إلى المحتوى الرئيسي

كيفية حفظ وإغلاق المصنف بعد عدم النشاط لفترة معينة من الوقت؟

في بعض الأحيان ، قد تغلق المصنف بطريق الخطأ عندما تكون مشغولاً بشؤون أخرى لفترة طويلة مما قد يؤدي إلى فقد بعض البيانات المهمة في المصنف. هل هناك أي حيل لحفظ المصنف وإغلاقه تلقائيًا إذا قمت بإلغاء تنشيطه لفترة معينة من الوقت؟

حفظ المصنف وإغلاقه تلقائيًا بعد عدم النشاط لفترة معينة من الوقت باستخدام VBA

السهم الأزرق الحق فقاعة حفظ المصنف وإغلاقه تلقائيًا بعد عدم النشاط لفترة معينة من الوقت باستخدام VBA

لا توجد وظيفة مضمنة في Excel لحل هذه المشكلة ، ولكن يمكنني تقديم رمز ماكرو يمكن أن يساعدك في حفظ المصنف وإغلاقه بعد عدم النشاط في وقت معين.

1. قم بتمكين المصنف الذي تريد حفظه وإغلاقه تلقائيًا بعد عدم النشاط لمدة ثوانٍ معينة ، ثم اضغط على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. انقر إدراج > وحدة لخلق وحدة البرنامج النصي ، ولصق الرمز أدناه عليه. انظر لقطة الشاشة:

Dim CloseTime As Date
Sub TimeSetting()
    CloseTime = Now + TimeValue("00:00:15")
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=False
 End Sub
Sub SavedAndClose()
    ActiveWorkbook.Close Savechanges:=True
End Sub

 

doc احفظ المصنف القريب بعد عدم النشاط 1

3. ثم في مستكشف المشروع جزء ، انقر نقرًا مزدوجًا هذا المصنف، والصق الكود أدناه في النص المجاور. انظر لقطة الشاشة:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call TimeStop
End Sub

Private Sub Workbook_Open()
    Call TimeSetting
End Sub

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

 

doc احفظ المصنف القريب بعد عدم النشاط 2

4. اذهب للنقر المزدوج على الوحدة التي أدخلتها في الخطوة 2 ، واضغط F5 مفتاح لتشغيل الكود. انظر لقطة الشاشة:
doc احفظ المصنف القريب بعد عدم النشاط 3

5. ثم بعد 15 ثانية ، يظهر مربع حوار لتذكيرك بحفظ المصنف ، والنقر فوق نعم لحفظ وإغلاق المصنف.
doc احفظ المصنف القريب بعد عدم النشاط 4

نصيحة:

(1) في الكود الأول ، يمكنك تغيير وقت عدم النشاط إلى آخر في هذه السلسلة: Now + TimeValue ("00:00:15")

(2) إذا لم تقم بحفظ المصنف من قبل ، فإن ملف حفظ باسم سيظهر مربع الحوار أولاً ويطلب منك حفظه.
doc احفظ المصنف القريب بعد عدم النشاط 5


خير حماية ورقة العمل

كوتولس ل إكسيل حماية ورقة العمل يمكن للوظيفة حماية أوراق متعددة أو المصنف بأكمله بسرعة.
doc حماية أوراق عمل متعددة

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (11)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
When I don't want to edit and I just want to consult, the file still closes. It shouldn't close. Should restart counting when I select cells. What is the solution?
This comment was minimized by the moderator on the site
When I don't want to edit and I just want to consult, the file still closes. It shouldn't close. Should restart counting when I select cells. What is the solution?
This comment was minimized by the moderator on the site
This is great. Any tips on adding a popup message box that will warn the user the sheet is about to close and give them the option to reset the timer?
This comment was minimized by the moderator on the site
I'm not sure what happened but this solution no longer works. Here is the fix to this solution that worked for me:

````
Dim resetCount As Long

Public Sub Workbook_Open()
On Error Resume Next
Set xWB = ThisWorkbook
resetCount = 0
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)On Error Resume Next
Reset
End Sub

Sub Reset()On Error Resume Next
Static xCloseTime
If resetCount <> 0 Then
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=False
resetCount = resetCount + 1
xCloseTime = DateAdd("n", 15, Now)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True

Else
resetCount = resetCount + 1
xCloseTime = DateAdd("n", 15, Now)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True
End If
End Sub
````
This is using the same SaveWork1 As:
````Sub SaveWork1()
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close

Application.DisplayAlerts = True
End Sub

````
This comment was minimized by the moderator on the site
If you are working in a separate workbook at the point where close time is reached then it will close that workbook and not the inactive one. This can be solved by adjusting the code to: - corrected and tested from the below comment - use this code:

Enter into "This Workbook"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call TimeStop
End Sub
Private Sub Workbook_Open()
Call TimeSetting
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call TimeStop
Call TimeSetting
End Sub


Enter into "module":

Dim CloseTime As Date
Sub TimeSetting()
CloseTime = Now + TimeValue("00:10:00")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
ThisWorkbook.Close Savechanges:=True
End Sub


you can change the time setting by changing CloseTime = Now + TimeValue("00:10:00") - this is set to 10 minutes, change the("00:10:00") to whatever time you want and it works.
This comment was minimized by the moderator on the site
hi i want insert this code to an other code like expiration code with this code how i can do....?
code is...following
Private Sub Workbook_Open()

Dim exdate As Date
Dim i As Integer

'modify values for expiration date here !!!
anul = 2019 'year
luna = 5 'month
ziua = 16 'day

exdate = DateSerial(anul, luna, ziua)

If Date > exdate Then
MsgBox ("The application " & ThisWorkbook.Name & " has expired !" & vbNewLine & vbNewLine _
& "Expiration set up date is: " & exdate & " :)" & vbNewLine & vbNewLine _
& "Contact Administrator to renew the version !"), vbCritical, ThisWorkbook.Name

expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name

On Error GoTo ErrorHandler
With Workbooks(ThisWorkbook.Name)
If .Path <> "" Then

.Saved = True
.ChangeFileAccess xlReadOnly

Kill expired_file

'get the name of the addin if it is addin and unistall addin
If Application.Version >= 12 Then
i = 5
Else: i = 4
End If

If Right(ThisWorkbook.Name, i) = ".xlam" Or Right(ThisWorkbook.Name, i) = ".xla" Then
wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
'uninstall addin if it is installed
If AddIns(wbName).Installed Then
AddIns(wbName).Installed = False
End If
End If

.Close

End If
End With

Exit Sub

End If

'MsgBox ("You have " & exdate - Date & "Days left")
Exit Sub

ErrorHandler:
MsgBox "Fail to delete file.. "
Exit Sub

End Sub
This comment was minimized by the moderator on the site
brilliant thanks
This comment was minimized by the moderator on the site
If you are working in a separate workbook at the point where close time is reached then it will close that workbook and not the inactive one. This can be solved by adjusting the code to:

Dim CloseTime As Date
Dim WKB As String
Sub TimeSetting()
WKB = ActiveWorkbook.Name
CloseTime = Now + TimeValue("00:00:15")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
Workbooks(WKB).Close Savechanges:=True
End Sub
This comment was minimized by the moderator on the site
I sometimes run into a "Running time Error" when open the workbook that has this code built into it. Anyway to write this code better for it to be more stable?
This comment was minimized by the moderator on the site
I noticed the same thing. And found the same solution :-)
This comment was minimized by the moderator on the site
The above code is not working when a cell is active. That is

1. enter a value in the cell (don't press Enter or tab)

2. minimize the excel.

In this case the code is not working.
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations