تعديل كود نسخة احتياطية وتأمين الخلايا

[أبو عبد الله _]

السلام عليكم 

وجدت الكود المرفق في احدى المشاركات 

والمطلوب التعديل عليه بحيث ان تكون النسخة الاحتياطية مؤمنة من اي تعديل ويمكن النسخ منها فقط 

ويفضل ان تكون النسخة الاحتياطية بدون الكود

Sub copy1()
Dim Extension$
Dim savePathName As String
Extension = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "Backup" & (Format(Now, " dd-mm-yyyy,hh.mm.ss AMPM")) & ".xls"
savePathName = "c:\Test Backup 1\"
    On Error Resume Next
    Application.DisplayAlerts = False
    GetAttr (savePathName)
    Select Case Err.Number
    Case Is = 0
        Application.DisplayAlerts = False
        ThisWorkbook.SaveCopyAs savePathName & Extension
        Application.DisplayAlerts = True
    Case Else
        MkDir savePathName
        ThisWorkbook.SaveCopyAs savePathName & Extension
    End Select
    On Error GoTo 0
End Sub

 

 

نسخة.xlsm

تم تعديل أبريل 25, 2023 بواسطه أبو عبد الله _

[أبو إيمان]

بخصوص التأمين للنسخة الجديد 

يمكن وضع السطر التالي في بداية الكود

ActiveSheet.Protect Password = "Jokem"

 

والسطر التالي في نهاية الكود

ActiveSheet.unProtect Password = "Jokem"

 

أما بخصوص أن تكون النسخة الجديدة بلا أكود فهذه النقطة يمكن لاحد العمالقة تنفيذها

[أبو عبد الله _]

شكرا 

كيف يمكن حذف الكود من النسخة الاحتياطية

[حسونة حسين]

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

عدل xls إلى xlsx في هذا السطر 

في 25‏/4‏/2023 at 11:47, أبو عبد الله _ said:

Extension = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "Backup" & (Format(Now, " dd-mm-yyyy,hh.mm.ss AMPM")) & ".xls"

 

[أبو عبد الله _]

في 26‏/4‏/2023 at 21:35, حسونة حسين said:

عدل xls إلى xlsx في هذا السطر

 

مشكور على الرد

هذا التعديل سوف يقوم بحذف الماكرو من النسخة ام ماذا

[حسونة حسين]

نعم اخي ان شاء الله