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

[الصّارم]

أخواني

كما هو في السؤال 

هل من كود يوقف عمل البرنامج بعد زمن معين؟؟

 

 

[ابو القبطان]

ان كنت فهمت ما تقصد ، هذا الملف يمكن التحكم في فترة توقفه واختفاؤه ( حاليا 10 ثواني )

hide file.rar

[عمر أبو صهيب]

حركة جميلة و مسلية أخي الكريم new4a

لكن ما فهمته من طلب الأخ الصارم هو يشتغل البرنامج لمدة معينة مثلا 30 يوما و بعدها يتوقف عن العمل أو يتوقف بعد عدد من مرات الفتح التي يتم تحديدها . و الله أعلم

تم تعديل فبراير 25, 2013 بواسطه دغيدى

[حمادة عمر]

السلام عليكم

الاخ الكريم / الصّارم

 

بعد اذن الاخوة الكرام

اليك اخي ملف رااائع للقدير دائما / عبد الله المجرب

الملف المرفق ملف يفتح لـ 5 مرات فقط ثم يغلق بعدها

ارجو ان يلبي طلبك

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

 

 

اغلاق ملف.rar

[ابو القبطان]

اخي : عمر 

ان صح اعتقادك فملف الاستاذ : عبد الله المجرب ، المرفق بمعرفة أخونا : حماده عمر .. يمكن زيادة العدد في الخلية A1

بالعدد المراد وليكن 30 مثلا ، وكذلك التغيير في الكود بنفس القيمة ليعمل الملف 30 مره

[عمر أبو صهيب]

جزاكما الله خيرا الأخوان الكريمان حمادة عمر و new4a على الإفادة

ملف الأخ عبد الله المجرب يفي بالغرض في مجاله .

و لكن ماذا لو أردت أن يتوقف الملف بعد استعماله لمدة ثلاثين يوما ( كما الشأن بالنسبة للبرامج التجريبية )

و أحسن الله إليكم جميعا مسبقا

[الصّارم]

بارك الله بالأخوة جميعا ما قصّرتم

وما تفضّل به الأخ عمر أبو صهيب هو ما أريده لو تكرمتم

[حمادة عمر]

السلام عليكم

الاخ الكريم / الصّارم

 

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

ولكنه للقدير العبقري الاستاذ القدير / جعفر طرباق  .... جزاه الله خيرا

 

بعنوان  ((( كيف نجعل الملف ينتحر و يحدف نفسه من الجهاز تلقائيا ! ))))

ولكني احببت ان انقله كما هو ليستفيد منه الجميع بكل طرقه واشكاله

 

=============================================

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

 

SuicidalWorkbook.rar

 

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

======================================================

 

الكود التالي يحدف الملف بعد شهر واحد من اول استعماله تلقائيا و بدون اشعار المستخدم !
ضع الكود في ThisWorkbook Module

 

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 الستعمالات تلقائيا و بدون اشعار المستخدم !
ضع الكود في ThisWorkbook Module

 

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

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

 

=========================================================

 

الكود التالي يحذف الملف بعد دقيقة واحدة من فتحه : (ضع الكود في ThisWorkbook Module)

 

Option Explicit

Private Const TIMEOUT As Long = 1

Private Sub Workbook_Open()

    Application.OnTime _
    Now + TimeSerial(0, TIMEOUT, 0), Me.CodeName & ".Kill_Myself"

End Sub

Private Sub Kill_Myself()
    
    With Me
        .Saved = True
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    
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
        Call NotifyUser
        Call Kill_Myself
    End If
    
End Sub


Private Sub NotifyUser()

    Dim sVbsFile As String
    
    sVbsFile = Environ("Temp") & "\VBS_MSG.vbs"
    
    Open sVbsFile For Output As #1
        Print #1, "Dim Wb"
        Print #1, "On Error Resume Next"
        Print #1, _
        "set wb=Getobject(" & Chr(34) & Me.FullName & Chr(34) & ")"
        Print #1, _
        "MSG= ""You have exceeded the Maximum Number of uses of this file."" & vbnewline & vbnewline"
        Print #1, _
        "MSG= msg & ""The file has been permanently deleted from your Drive !"""
        Print #1, "Do"
        Print #1, "Loop until wb.name="""""
        Print #1, "WScript.Echo MSG"
    Close #1
    
    Call Shell("WScript.exe " & sVbsFile)

End Sub

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

وارجو من الله ان يجعل فيها افادة ... وادعو للاستاذ القدير العملاق / جعفر  ... جزاه الله خيرا

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

[الصّارم]

بارك الله بك اخ حمادة

فعلا كفيت ووفيت

[عمر أبو صهيب]

جزاك الله خيرا أخي الكريم حمادة عمر

مبدع كعادتك

[حمادة عمر]

بارك الله بك اخ حمادة

فعلا كفيت ووفيت

 

السلام عليكم

الاخ الكريم / الصّارم

 

بارك الله فيك

والحمد لله انك وصلت لمبتغاك ... هذا ما نتمناه دائما

والشكر الاول والاخير للرائع الاستاذ / جعفر

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

[حمادة عمر]

السلام عليكم

الاخ الكريم / عمر أبو صهيب

 

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

وتشجيعك الدائم لي

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

وايضا لضمان الحقوق الشكر الاول والاخير للرائع الاستاذ / جعفر

فما قمت الا باحضار الحل فقط

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

[اسلام سيد]

الاخ حماده عمر

 

بارك الله فيك وجزاك الله كل خير

 

هل يمكن فى حاله الكود الاول هو اغلاق الملف ب 5 مرات ألا يفتح إلا بعد كتابة باسورد ثم  يلغى عمل الكود بعد الباسورد.

[حمادة عمر]

السلام عليكم

الاخ الكريم / إسلام الشيمي

 

بارك الله فيك

اليك اخي محاولة مني وتعديل طفيف علي كود القدير / عبد الله المجرب

علي ملف الموجود بالمشاركة رقم  4#

والخاص باغلاق الملف بعد فتحة 5 مرات

 

اليك تعديل يجعل الملف يفتح لعدد 5 مرات وبعد ذلك لا يفتح الا بعد طلب رقم سري

وان كان الرقم غير صحيحا يعمل علي اغلاق الملف

وان كان الرقم صحيحاً تم الدخول للملف

 

الرقم السري هو : 12345

وطبعا يمكنك تغييره كما تريد وذلك بتغييره في الكود نفسه

وانتظر ردك بالنتيجة ...

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

 

اغلاق ملف بعد فتحه 5 مرات وفتحه بعد ذلك برقم سري.rar

[عمر أبو صهيب]

السلام عليكم

الاخ الكريم / إسلام الشيمي

 

بارك الله فيك

اليك اخي محاولة مني وتعديل طفيف علي كود القدير / عبد الله المجرب

علي ملف الموجود بالمشاركة رقم  4#

والخاص باغلاق الملف بعد فتحة 5 مرات

 

اليك تعديل يجعل الملف يفتح لعدد 5 مرات وبعد ذلك لا يفتح الا بعد طلب رقم سري

وان كان الرقم غير صحيحا يعمل علي اغلاق الملف

وان كان الرقم صحيحاً تم الدخول للملف

 

الرقم السري هو : 12345

وطبعا يمكنك تغييره كما تريد وذلك بتغييره في الكود نفسه

وانتظر ردك بالنتيجة ...

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

 

اغلاق ملف بعد فتحه 5 مرات وفتحه بعد ذلك برقم سري.rar

عمل أكثر من رائع من أخ أروع

هذا يجعل الفكرة أكثر تنوعا

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

[اسلام سيد]

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

[اسلام سيد]

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

 

الى اخى الغالى حماده عمر

 

ياحبذا لو عندما يغلق البرنامج بعد الخمس مرات ويطلب بعدها الرقم السرى  (ان تختفى كل الصفحات ) ولايظهر شى ولا يسمح بالتنقل بينها

 

رووووووووعه موضوع العداد

 

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

 

وتكون فى مربع بلون مختلف فى اعلى منتصف الصفحه

 

اسف على الاطاله  ، وفقك الله.

[حمادة عمر]

السلام عليكم

الاخ الكريم / عمر أبو صهيب

 

بارك الله فيك

وشكرا علي كلماتك الرائعة

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

[حمادة عمر]

السلام عليكم

الاخ العزيز / إسلام الشيمي

 

بارك الله فيك

وان شاء الله طلبك سأقوم بالعمل عليه

ولكن انتظرني بعض الوقت وعند انهاؤه سأخبرك بذلك

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

[Akram Galal]

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

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

الاخوة الاعزاء

جزاكم الله خير على ذلك الصرح من المعلومات

سلمت يداكم

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

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

هلى يمكن عمل كود يقوم بحفظ الملف save as

فى \d:\ A

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

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

 

والملف الذى تم نسخه لا يتم فتحه الا بكلمه سر

واذا امكن ذلك برجاء شرح الكود ....

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

تم تعديل يناير 20, 2014 بواسطه ۩◊۩ أبو حنين ۩◊۩

[غالب عبد]

السلام عليكم 
الأخ حمادة عمر 
جزاك الله عنا كل خير

[hanymoaty]

السلام عليكم

الاخ الكريم / الصّارم

 

بعد اذن الاخوة الكرام

اليك اخي ملف رااائع للقدير دائما / عبد الله المجرب

الملف المرفق ملف يفتح لـ 5 مرات فقط ثم يغلق بعدها

ارجو ان يلبي طلبك

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

 

 

اغلاق ملف.rar

 

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

 

حاولت مراسلتك كمشرف بالمنتدى و لم يمكنني المنتدى من ذلك 

 

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

 

http://www.officena.net/ib/index.php?showtopic=53268&p=334461

[عبدالرحمان01]

شككككككككككككككككككككككككككككككككككككككككككككككككككككككككررررررررررررررررررررررررررررررررررررررررررررررررا