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

[ksa999]

السلام عليكم كيف الغي الحماية في التوقيت

 

حيث انه يظهر البيانات مره اخرى

 

بدون اخفائها بفترة معينة

[ksa999]

كيف الغي العداد لمده معينة مثلا شهر وقفل البرنامج 

علما بان الاكواد مخفيه

[king father]

مجهود اكثر من رائع الموضوع ده فادنى كتير جدا جزاكم الله خيرا

 

 

[m1808269]

ررررررررررررررررررررررررررررررروعه

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

[مساهدية نجيب]

Option Explicit
 
Private Const MSG_TITLE As String = "Deleting Current Workbook ..."
Private Const MSG_TEXT As String = _
"You are about to permanently delete the current workbook located in :"
 
 
Sub Kill_Myself()
 
    Dim lUserDecision As Long
    Dim sMsg As String
    
    On Error Resume Next
    
    sMsg = "Attention !" & vbNewLine & vbNewLine
    sMsg = sMsg & MSG_TEXT & vbNewLine
    sMsg = sMsg & "'" & ThisWorkbook.FullName & "'" & vbNewLine
    sMsg = sMsg & "from Disk!!" & vbNewLine & vbNewLine
    sMsg = sMsg & "Go ahead ?" & vbNewLine & vbNewLine
 
    Beep
    lUserDecision = _
    MsgBox(sMsg, vbExclamation + vbYesNo, MSG_TITLE)
    With ThisWorkbook
        If lUserDecision = vbYes Then
            .Saved = True
            .ChangeFileAccess xlReadOnly
            Kill .FullName
            .Close False
        End If
    End With
 
End Sub

الحذف بعد شهر

Option Explicit

Private Sub Workbook_Open()

    Dim lInitialDate As Long
    
    On Error Resume Next
    
    lInitialDate = Evaluate("InitialDate")
    
    If Err.Number = 13 Then
        Me.Names.Add "InitialDate", Date, False
        Me.Save
    End If
    
    If Date > Evaluate("InitialDate") + 30 Then Kill_Myself

End Sub

Private Sub Kill_Myself()
 
    .Saved = True
    .ChangeFileAccess xlReadOnly
    Kill .FullName
    .Close False
 
End Sub

بعد 3 مرات 

Option Explicit

Private Const MAX_USES As Long = 3

Private Sub Workbook_Open()

    Dim lNumberOfUses As Long
    
    On Error Resume Next
    
    lNumberOfUses = Evaluate("NumberOfUses")
    
    If Err.Number = 13 Then
        Me.Names.Add "NumberOfUses", 1, False
        Me.Save
        Exit Sub
    End If
    
    Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False
    Me.Save
    If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself

End Sub

Private Sub Kill_Myself()
    
    With Me
        .Saved = True
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    
End Sub 
 

[m1967]

بارك الله فيكم وزادكم علما واطلب منك كيف احمى ملف حصلت عليه من التدمير الذاتى وغيره من الملفات التخريبية

 

[fethi216]

لو تكرم الاخوة الافاضل مر علي موضوع حذف محتوى ورقة العمل عند نسخها في جهاز آخر، يعني يقارن الرقم التسلسلي للهارد او شيء من ذاك القبيل، ارجو امدادي به 

[Fahmi0]

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

الاخوة الافاضل .... اكرمكم الله على كل مجهود الذي بذلتموه

1- هل يمكن عمل كود يقوم بحفظ الملف save as بشكل تلقائي

فى مكان معين D:\

وذلك فى وقت محدد وبشكل يومي بمعنى الساعه 1 ص من كل يوم .. يقوم بعمليه النسخ . دون اظهار دلااله على الحفظ للمستخدمين

2- هل يمكن عمل كود يقوم بإغلاق الشيت بعد فترة معينه مثلا من تاريخ 1/3/2019 الى تاريخ 31/3/2019 في تمام الساعة 11:59:59 يغلق ولا يفتح إلا بالرقم السري معين

تم تعديل مارس 1, 2019 بواسطه Fahmi0
خطاء املائي

[مهند محسن]

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

لا يمكن عمل هذا استاذ فهيم

 

[Atef Singer]

الله يبارك فى حضرتك..... مبدع