حفظ نسخ أرشيف لملفات الاكسل

[أب مارية]

السلام عليكم

لدي ملف اكسل أريد عند كل عملية حفظ أن يحتفظ بنسخة الملف القديمة ويضعها في ملف خاص بالارشيف

هل هذا ممكن أم لا.

مشكورين مسبقا

[خزاني]

Sub Archiver()
Dim DateEtHeure, Chemin, NomArchive, rep, Fichier, n&

DateEtHeure = Format(Now(), "yyyymmdd") & Format(Time, "hhmmss")
DateEtHeure = DateEtHeure & " le " & Format(Now(), "ddd dd-mmm-yyyy")
DateEtHeure = DateEtHeure & " à " & Format(Time, "hh-mm-ss")

rep = MsgBox("هل تريد نسخة من الملف", _
        vbQuestion + vbDefaultButton1 + vbYesNo)
If rep = vbYes Then
  Chemin = ThisWorkbook.Path
  If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
  NomArchive = "Archive " & DateEtHeure & ".xlsm"
  ThisWorkbook.SaveCopyAs Chemin & NomArchive
  

  ChDir Chemin
  Fichier = Dir("ارشيف " & Format(Now(), "yyyymmdd") & "*.xlsm")
  Do Until Len(Fichier) = 0 Or n = 10
    If LCase(Fichier) <> LCase(NomArchive) Then Kill Chemin & Fichier
    Fichier = Dir("Archive " & Format(Now(), "yyyymmdd") & "*.xlsm")
    n = n + 1
  Loop
End If

End Sub

[أب مارية]

السلام عليكم

بارك الله يك أخي خزاني على الكود 

من فضلك أين يتم وضع هذا الكود

[أب مارية]

للرفع

[ياسر خليل أبو البراء]

أخي الفاضل

رأيت لك موضوعات كثيرة بالمنتدى ..وإلى الآن لا تعرف كيفية وضع الأكواد (لازم أعاتبك ..!! لأن دا سنة أولى برمجة .. فيه حلقات افتح الباب أنصحك بها)

بالنسبة لطلبك أين يوضع الكود

اضغط Alt + F11 سيفتح لك محرر الأكواد .. من القائمة Insert أي إدراج قم بإدراج موديول جديد وانسخ الكود والصقه في الموديول وقم بحفظ المصنف بامتداد Xlsm

وإليك مرفق موضوع به الكود ..

والشكر موصول للأخ خزاني على الكود الرائع ..بارك الله فيك

تقبلوا تحياتي

Archiver.rar

[أب مارية]

السلام عليكم

شكر جزيل للاخوة الأفاضل 

الأخ YasserKhalil معك حق ومشكور على النصيحة سأعمل بها ان شاء الله 

لكن هل من الممكن جعل الكود يعمل عند الضغط على زر حفظ في شريط الأدوات بدل اضافة زر في الورقة

تم تعديل مارس 1, 2015 بواسطه أب مارية

[ا بو سليمان]

كيف يتم  الحفظ مع  الترحيل لكي يصبج الملف  يحوي بيانات داتا شهرين او ثلاثه اشهر