اضافة كود لحفظ نسخة من الملف تلقائيا فى بارتشن اخر

[صياد الجراح]

بسم الله الرحمن الرحيم

السلام عليكم اخوانى . ولكم جميعا كل الشكر والتقدير على مجهودكم

ده ملف بسيط فيه كود لحفظ الملف كل عدد معين من الثوانى  .. الكود خاص به ا. ياسر ابو براء  بارك الله فيه وحفظه من كل سوء

انا محتاج اضيف له كود  عشان يحفظ الملف فى بارتشن اخر تلقائيا بمعنى يكون عندى نسختين من الملف النسخةالاساسية ونسخة تانية فى بارتشن اخر   .. بالبحث  فى المنتدى لاقيت الكود ده بس مش عارف اضيفه للكود المرفق ازاى  (d) مثلا 

 عشان يحفظ الملف اوتوماتيك  كل عدد معين من الثوانى فى النسختين 

الكود

Sub حفظ_الفاتورة()
   MyNime = Cells.Text & "e:\" & Cells(1, 2).Text & Nombre & ".xls"
   ActiveWorkbook.SaveCopyAs MyPathDirectory & MyNime
End Sub

واذا الكود ده مش حينفع و هناك كود اخر يقوم بالمطلوب  يبقى تمام ..لكم فائق احترامى  وتقديرى 

تجريبى.xlsm

[محمد هشام.]

تفضل اخي

Workbook ضع هدا الكود في حدث 
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:15"), "SAVE_MH"
Call SAVE_MH
End Sub
Module وهدا في
Sub Save_MH()
Application.DisplayAlerts = False
Application.OnTime Now + TimeValue("00:00:15"), "SAVE_MH"
ActiveWorkbook.SaveCopyAs Filename:="c:\Backups\" & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub
Sub Save2_MH()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("00:00:15"), "Save2_MH"
End Sub

قد تمت اضافة الكود للملف للتجربة     

  في حالة كانت عندك رغبة بالاحتفاظ بجميع النسخ رغم انني ارى انك في غنى عنها يمكنك جعل الكود بهده الطريقة و تجعلها كل 10 دقائق مثلا 
Workbook ضع هدا الكود في حدث 
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:10:00"), "save_MH3"
'Application.OnTime Now + TimeValue("00:00:15"), "save_MH3"
Call save_MH3
End Sub
---------Module وهدا في----------
Sub save_MH3()
Dim MyDate
MyDate = Date
Dim MyTime
MyTime = Time
Dim TestStr As String
'تاريخ اليوم
TestStr = Format(MyTime, "hh-mm-ss")
Dim Test1Str As String
'ساعة الحفظ 
Test1Str = Format(MyDate, "DD-MM-YYYY")
Application.DisplayAlerts = False
'Application.OnTime Now + TimeValue("00:00:15"), "save_MH3"
Application.OnTime Now + TimeValue("00:10:00"), "save_MH3"
'تحديد مسار حفظ الملف
ActiveWorkbook.SaveCopyAs Filename:="c:\Backups\" & Test1Str & ". " & TestStr & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub
Sub Save2_MH()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("00:00:15"), "Save2_MH"
End Sub

تجريبى-حفظ نسخة من الملف كل 10 دقائق.xlsm تجريبي.xlsm

[صياد الجراح]

الف شكر اخى على تعبك ومجهودك لك ودى وتقديرى ..اول ما بفتح الملف تجريبى اللى حضرته ارفقته بيفتح على خطأ فى الكود 

موضحة فى الصور المرفقة  

[محمد هشام.]

قم بإلغاء حدث workbook حتى تقوم بتعديل مسار حفظ الملف على جهازك. ثم أعد تفعيله من جديد

الملف يشتغل عندي بدون مشاكل!!!!! 

[صياد الجراح]

تعديل المسار بيتم فى كود الموديل فقط مكان             ( c:/backup/)

 فقط  ولا هناك اماكن اخرى بعدل فيها المسار ..  او اى تعديلات اخرى المفروض اعملها  فى الاكواد لان بعد تغيير المسار نفس الخطا 

[محمد هشام.]

اخي الفاضل المسار غير صحيح انشا مجلد داخل بارتشين
 E
 Backups باسم   ... وقم باستبدال المسار هكدا

ActiveWorkbook.SaveCopyAs Filename:="e:\Backups\" & ActiveWorkbook.Name

 

[محمد هشام.]

أخي الفاضل هذه مسألة طبيعية .هذا بسبب أنك تقوم بفتح الملف في نفس المسار الذي يتم حفظه فيه جرب نسخه إلى مكان آخر  قبل فتحه وشاهد النتيجة 

او تغيير صيغة حفظ الملف من    xlsM إلى  xlsx

 

 

[صياد الجراح]

بارك الله فيك أخي الفاضل  ..فهمت المشكله الحمد الله 

أن الكود الحفظ كده شغال ف النسخه الاحتياطيه وعشان تشغلها يبقه حيحفظها مرتين ف نفس المكان وبنفس الاسم وده مش حينفع وهو سبب الخطأ لازم تكون ف مسار تاني  ..الملف والكود اشتغل تمام..الف شكر على اهتمامك ومتابعتك.. لك ودي واحترامي لشخصك الكريم