مطلوب كود لحفظ البيانات على شيت الاكسيل تلقائيا إذا انقطع التيار الكهربائى فجأه ؟

[اسلام سيد]

السلام عليكم ورحمة الله وبركاته

اريد كود لحفظ البيانات يعمل تلقائيا إذا انقطع التيار الكهربائى فجأه

 

مع العلم انى معى كود يعمل على حفظ الملف تلقائيا قبل غلق الملف وهو كالاتى

 

 

Sub workbook_beforeclose(cancel As Boolean)
If Me.Saved = False Then Me.Save
End Sub
 

[الـعيدروس]

السلام عليكم

 

بالامكان الاستعانه بهذا الكود

يقوم بحفظ الملف كل دقيقة

 

هذه الأكواد في مودويل

 

Public Rm As Double
Public Const C_Con = 60
Public Const Sc_W = "Ex"
Public Sub St_A()
    Rm = Now + TimeSerial(0, 0, C_Con)
    Application.OnTime EarliestTime:=Rm, Procedure:=Sc_W, Schedule:=True
End Sub
Sub Ex()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
St_A
End Sub

 

وهذه في حدث Thisworkbook

 

Private Sub Workbook_Deactivate()
Call St_A
End Sub
Private Sub Workbook_Open()
Call St_A
End Sub

[اسلام سيد]

وعليكم السلام

 

هل من الممكن اجعل Public Const C_Con = 60

 

 

  Public Const C_Con = 1

 

 

وبذالك يصبح التخزين كل ا ثانيه ام لا

[الـعيدروس]

غير الى اي جزء من الدقيقة او الثانيه

بمعنى 1= ثانيه و  0.5 نصف ثانية

يعمل معك إن شاء الله

[اسلام سيد]

بارك الله فيك استاذنا القدير لقد جربت وحققت الهدف بنجاح

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عباد

 

رائع وجميل جدا

وحشتنا اعمالك واعمال كل اساتذة هذا الصرح العظيم

في الفترة التي كان يحدث للمنتدي ترقية فيها

لا حرمنا الله منكم وزادكم الله من فضله وعلمه

 

جزاك الله خيرا

[الـعيدروس]

اخواني الاحبه 

 

هذا تعديل للكود بعد تجربته

عند فتح اكثر من ملف 

واغلاق الملف الذي به الكود 

يفتح الملف مره اخرى وذلك بسبب التايمر في وضع التشغيل

عموما هذا هو التعديل

 

هذه الأكواد في حدث Thisworkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Ext
End Sub
Private Sub Workbook_Open()
Call St_A
End Sub

 

وهذه الأكواد في مودويل

 

Public Rm As Double
Public Const C_Con = 3
Public Const Sc_W = "Ex"
Public Sub St_A()
On Error Resume Next
  Rm = Now + TimeSerial(0, 0, C_Con)
  Ali_C Rm, Sc_W, True
End Sub
Sub Ex()
 Application.DisplayAlerts = False
  ThisWorkbook.Save
 Application.DisplayAlerts = True
   St_A
End Sub
Public Sub Ext()
  Ali_C Rm, Sc_W, False
End Sub
Public Function Ali_C(St As Double, Sa As String, Bn As Boolean)
On Error Resume Next
 With Application
 DoEvents
 .ScreenUpdating = False
  .EnableEvents = False
   .OnTime EarliestTime:=St, Procedure:=Sa, Schedule:=Bn
  .EnableEvents = True
 .ScreenUpdating = True
 End With
End Function

تم تعديل يناير 26, 2013 بواسطه عباد

[اسلام سيد]

الكود رائع استاذ / عباد  سواء المشاركه الاولى او الثانيه بارك الله فيك

[إبراهيم ابوليله]

الاخ الكريم

عباد

بارك الله فيك

اكوادك فعلا رائعه

وبالتاكيد كل من ا يحتاج لهذا الكود

[دغيدى]

أخى / عباد

بارك الله فيكم 

كود رائع

[ahmed_kamal20012002]

جزاكم الله كل خير على ماتقدمونه من علم وبارك الله فيكم وجعله فى ميزان حسناتكم